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ABSTRACT 


This report describes the basic laboratory data manipulation tools. 
The set of computer programs described herein allow for data definition, 
data input, and data transfer between the LSI-11 microcomputers and the 
VAX-11/780 minicomputer. Program VAXCOM allows for a simple method of 
textual file transfer from the LSI to the VAX. Program LSI COM allows 
for easy file transfer fr:'n the VAX to the LSI. Program TTY changes the 
LSI-11 operators console to the LSI's printing device. Program DICTIN 
provides a means for defining a data set for input to either computer. 
Program DATAIN is a simple to operate data entry program which is cap- 
able of building data files on either machine. Program LEDITV is an 
extremely powerful, easy to use, line oriented text editor. Program 
COPYSBF is designed to print out textual files on the line printer with- 
our character loss from Fortran carriage control or wide record transfer. 
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HARDWARE DESIGN AND CONFIGURATION 


A. GENERAL DESCRIPTION 


The hardware unit which Is employed to facilitate the Interconnec- 
tions of the devices forming the communications link Is called "3 
PORT RS-232 JUNCTION". The unit Is a Junction box for up to three 
devices via their EIA- STANDARD RS-232 cabling. Drawing TH8145-1A01 
Is a pictorial view of the unit. It Is a rack-mounted unit 19 x 
5.25 X 7 Inches which also houses the Peril Corporation model PSH-96A 
modem, or provides a link to an appropriate acoustic coupler. 

The device Is a compact connection unit that allows serial communi- 
cation devices and terminal equipment such as high-speed printing 
terminals, video displays, computers and modems to be combined In 
a common system. Control toggle switches are provided to Implement 
any combination of connections between the Input and output of the 
three ports . 


B. EIA STANDARD RS-232C 


This standard was created by the Electronics Industries Association 
(EIA). It defines the electrical characteristics for Interfacing 
between some form of Data Terminal Equipment (DTE) and some form 
of Data Communications Equipment (DCE). A DTE Is a terminal for 
the time-share user, and a DCE Is a modulator/ demodulator (modem) 
for the encoding of digital data Into voice-like signals permissable 
for transmission over the telephone system. 

Drawing TH8145-1C04 details the various signals of this communications 
standard. There are two data-carrying lines, one each for the trans- 
mitted and received data, and a signal ground. There are many more 
lines that serve as control wires between the DTE and DCE, but the 
three mentioned above (transmit, receive, and ground) are the ones 
needed for communications per se. Not all equipment manufacturers 
utilize the control lines. 

The names of the RS-232 signals are from the perspective of the 
DTE. Thus, the DTE transmits on the Transmitted Data Line (pin 2) 
and the DCE receives on It. Similarly, the DTE receives data on 
the Received Data Lines (pin 3) and the DCE transmits on It. 
Manufacturers of various types of equipment may design their Inter- 
face connections as either a DTE or DCE. Therefore, direct connections 
of two devices may, or may not, be compatible. Pins 2 and 3 may 
require reversing, and is easily accomplished In tne 3 Port RS-232 
Junction device via a double-pole-double-throw toggle switch. A 
"POLARITY" switch is installed for each of the three ports (devices). 
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A particular manufacturer may, or may not utilize the other 
control lines of the RS-232 connection. Drawing TH8145-1E05 details 
the wiring of the RS-232 connectors of the devices used In this 
application. 


i. OPERATION 


The 3 Port RS-232 Junction Is equipped with three connectors 
(one for each port). Each connector Is associated with a logic 
circuit and Is dependent of the other two ports. Drawing No. 
TH8145-1B02 Is a simplified diagram of the unit. Each circuit 
has a double pole-double-throw polarity switch which selects 
either pin 2 or 3 (receive data and transmit data lines) and 
routes the selected line to an RS-232 driver or receiver. An 
explanation of the need for the "POLARITY" switch Is described 
In the section concerning the EIA STANDARD RS-232. 

The data output of the line receiver associated with each port 
Is connected to "DATA ENABLE" switches which allow the data to 
be passed to one or both of the other ports as selected by the 
operator (user). All the switches are located on the front panel 
and llght-emitting-dlodes (LEDs) are Illuminated to show when a 
particular data path has been enabled. The LEDs will ^Iso flash, 
or dim, with the data rate during transmission times serving as 
a visual Indication of the presence of data. 


D. DATA TRANSMISSION RATE 


The user of the 3 Port RS-232 Junction must ensure that all 
transmitting and receiving devices are matched with the same 
BAUD RATE (bits per second). Most manufacturers provide hardware 
.lumpers, switches, or software program control for selection of 
a desired BAUD RATE. Reference to a particular manufacturer's 
equipment manual will be required to ascertain correct selection 
the data rate. 

Standard BAUD RATES are listed below: 


50 

150 

1200 

3600 

75 

300 

1800 

4800 

no 

600 

2400 

9600 


134.5 


2 


E . DEVICE CONNECTIONS 


Drawing TH8145-1A09 shows the proper connections of the three 
devices via their RS-232 cables. The processor Is connected through 
Its serial device Interface card (DLV-11). It Is Important that the 
devices be connected to the correct connector In order to match the 
labeling of data paths on the front panel. 

The device connections are as follows; 

Connector - Device 
Jl— MODEM 
J2— COMPUTER 
J3— TERMINAL 

F. INPUT POWER CONNECTIONS 


The RS-232 Junction device requires the following DC power: 

+12V0C @ 35 mllllamperes 
-12VDC 9 35 mllllamperes 
+ 5VDC 9 400 mllllamperes 

The Input power Is wired during Installation and Is obtained from 
separate power supplies or from the computer's power supplies when 
available. All power connections are made to the Input power terminal 
block as detailed In Drawing TH8145-1E06. 


G. OPERATOR CONTROL/SET-UP 

With the device connected to the 3 Port Junction unit, the user 
must place the POLARITY switch for each device In the proper 
position, and the DATA ENABLE switches must be positioned to select 
the desired data paths between each of the RS-232 devices. Drawing 
TH8145-1A03 shows the location of the switches and lamps. The 
labeling of the front panel shows the transmit and receive data 
paths between each device. The arrows depict the data flow direction. 
When a particular data path Is enabled the associated Indicator 
lamp will be Illuminated, consequently the lamp will be turned off 
with a disabled data path. 

Once the POLARITY switch for each device is properly positioned, 
there 1s no need to alter the switch setting unless a different 
RS-232 device Is connected to the associated port. The POLARITY 
switches are Installed only to provide circuit flexibility in that 
regard. The P0',ARITY switch selects and routes the RECEIVE DATA 
and TRANSMIT DAIA lines to recel vers/ dri vers . The reader should 
reference the section titled EIA STANDARD RS-232C (page 
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H. SET-UP PROCEDURE 


Reference Drawing No. 8145-1A03. 

With all RS-232 compatible devices connected to the 3 Port Junction, 

and all power turned on, perform the following procedure in sequential 

steps . 

1) Enable only the data path from the TERMINAL to the 
MODEM (DATA ENABLE SWITCH S5). The associated lamp 
(L2) must be on. 

2) Depress the "BREAK KEY" on the terminal keyboard. 

The Indicator lamp (L2) should momentarily turn off. 

If not , reverse the positioning on the TERMINAL'S 
WLaRITY switch (S3). 

3) Enable the data paths In both directions between the 
TERMINAL and MODEM (switches S5 and S8). Lamps L5 and 
L2 should be "on". 

4) Momentarily depress the "RETURN KEY" on the terminal’s 
keyboard. The VAX computer (Connected to the modem) 
should respond Immediately by causing the terminal to 
print "USERNAME" If n.-t, reverse the MODEM'S polarity 
switch (SI) and dep»»;.s the "RETURN KEY" again. 

5) Enable the path from the computer to the terminal 
(switch S9). Data lamp should be "ON". 

6) Instruct the COMPUTER to output some form of data to the 
TERMINAL, e.g. print a file. 

7) Monitor the TERMINAL for the received data, and If not 
received, reverse the COMPUTER'S POLARITY switch (S2). 

Repeat STEP 6 and 7. 

8) The POLARITY swi tches for the three devices are now 
a; the proper position and should not be altered. 

The user may set-up any data paths as desired for 
communications between the three devices. The data links 
may be: undl recti onal , bidirectional, or any combination 
thereof. However, If the two devices are configured to 
transmit to a common device, caution should be exercised 
to prevent these devices from transmitting simultaneously 
which would result In data loss and/or errors. 
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II. HARDWARE SCHEMATICS 
3PORTRS-232 JUNCTION 

DRAWING NUMBER 

TH8145-1A0I 
TH6145-1B02 
TH8145-1A03 
TH8I45-1C04 
TH81 45-1 EOS 
TH8145-1E06 
TH8145-1A07 
TH8145-1E08 
TH8145-1A09 


TITLE 

PICTORIAL VIEW 
SIMPLIFIED DIAGRAM 
SWITCH & LAMP LOCATIONS 
STANDARD PIN CONNECTIONS (RS-232) 
CONNECTOR WIRING 
INPUT POWER TERMINAL 
ASSEMBLY, LOGIC CARO 
SCHEMATIC, LOGIC CARD 
DEVICE CONNECTIONS 
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III. Program Compilation and Linkage 

A. VAXCOM 

1 . On the LSI 

a. To compile: 

FORTRAN VAXCOM 

b. To link: 

LINK VAXCOM 

B. LSICOM 

1 . On the LSI 

a. To compile: 

FORTRAN LSICOM 

b. To link: 

LINK LSICOM 

2. On the VAX 

a. To compile: 

FORTRAN LSICOM 

b. To link: 

LINK LSICOM 


C. DICTIN 

1 . On the LSI 

a. To compile: 

RUN LEDITV 

FILE-OICTIN.FOR 

0S:/CLSI/;* 

Create three separate i1les: 

File 1 contains: Main Program, LCASE 
File 2 contains: COPYA, COPYD, COPYM.COPYE, FETCH, 
VALNAM, OVERLP, REPORT, HANG 
File 3 contains: ELEMNT, ELEVAL, REORDR 
Compile the files: 

FORTRAN FILE! 

FORTRAN FILE2 
FORTRAN FILE3 


15 



b. To link: 

LINK/PROMPT/EXECUTE :DICTIN FILE1 

*FILE2/0:1/C 

*FILE3/0:1// 

2. On the VAX 

a. To compile: 

RUN LEDITV 

FILE-OICTIN.FOR 

OS:/CVAX/;* 

Compile : 

FORTRAN/NOI4 OICTIN 

b. To link: 

LINK OICTIN 


0. OATAIN 

1 . On the LSI 

a. To compile: 

RUN LEOITV 
FILE -OATAIN. FOR 
OS:/CLSI/;* 

Create two files: 

File 1 contains: Main Program, LCASE 
File 2 contains: VALIO, FETCH, SIZE, OATA 
File 3 contains: REPORT, HANG 
Compile the files: 

FORTRAN FI LEI 
FORTRAN FILE2 
FORTRAN FILE 3 

b. To link: 

IF LSI-11/02: 

LINK/PROMPT/EXECUTE :DATAIN FILE! 
*FILE2/0:1/C 
*FILE3/0:1// 
ir LSI-11/23 

LINK/ PROMPT/LIB : FPU/EXE : OATAIN FILE! 

*FILE2/0:1/C 

*FILE3/0:\// 

2. On the VAX 

a. To compile: 

RUN LEOITV 

FILE-OATAIN.FOR 

OS:/CVAX/;* 

Compile: 

FORTRAN/ NO I 4 OATAIN 

b. To link: 

LINK OATAIN 
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E. ..EDITV 


1 . On the LSI 

a. To compile: 

Run an editor 

FILE-LEOITV.FOR 

If LSI is a 32K machine; 

0S:/CLSI32/;* 

If LSI Is a 64K machine: 

DS:/CLSI64/;* 

If LSI Is a 96K machine: 

0S:/CLSI96/;* 

If LSI Is a 128K machine: 

DS;/CLSn28/;* 

For all machines: 

RS./CLSI/,/ /;• 

NOTE: Care should be taken not to delete CLSI from 

unwanted fortran statements, I.e. do not delete 
the CLSI In front of CLSI 96 when compiling for 
a 32K machine. 

Create three separate files: 

File 1 contains: Main Program, IFIND 
File 2 contains; PARSE ,SETLC 
File 3 contains; RECM6R, SBGET, KBGET 
Compile the files: 

FORTRAN/UNITS: 7 FILE 
FORTRAN/UNITS: 7 FILE 2 
FORTRAN/UNITS: 7 FILE 3 


b. To link: 

LINK/PROMPT/EXECUTE :LEDITV FILE ’ 
♦FILE 2/0:l/C 
♦FILE 3/0:1// 


2. On the VAX 

a. To compile: 

Run an editor 
FILE » LEDITV.FOR 
DS:/LVAX// 

Compile; 

F0RTRAN/N0I4 LEOITV 

b. To link: 

LINK LEOITV 


F. COPYSBF 


1 . On th« LSI 

a. To compile: 

RUN LFDITV 

FILE-COPYSB.FOR 

OS:/CLSI/;* 

Compile: 

FORTRAN COPYSB 

b. To link: 

LINK COPYSB 

2. On the VAX 

a. To compile: 

RUN LEDITV 

FILE-COPYSBF.FOR 

DS:/CVAX/;* 

Compile : 

FORTRAN COPYSBF 

b. To link: 

LINK COPYSBF 


G. TTY 

1 . On the LSI 

a. To assemble: 

MACRO TTY/LIST/CR 

b. To link: 

LINK TTY 
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E. LEDITV 

F. COPYSBF 
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PROGRAM NAME i UAXCOM 

DESIGNER/ ANAL VST' CRAIG E. LITTON 

PROGRAMMER SCOTT G. THOMPSON 

DATE SEPTEMBER l?8l 


i 

I 

‘ COMPUTER SYSTEM 

LSI-ll> 

UAX-U/7S0 

OPERATING SYSTEM: 

{ 

RT-llv4, 

UAX/UMS 


COMPILING SEQUENCE! 

LSIi FORTRAN UAXCOM 

UAXi 

LINKING SEQUENCE: 

LSI: LINK UAXCOM 

UAX: 

EXECUTION SEQUENCE j RUN UAXCOM 
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PROGRAM UAXCOH 


TECHNOLOGY INCORPORATED 
LIFl SCIENCES DIOISION 
16811 BUCCANEER DR./ S. 206 
HOUSTON/ TEXAS 77058 

DEPARTMENT OF BIOMATHEHATICS 
13 MARCH 1981 


UERSION 2.0 

AUTHOR I CRAIG E. LITTON 


PROGRAMMER! SCOTT G. THOMPSON 

THIS PROGRAM IS DESIGNED TO EMULATE A UAX TIMESHARING TERMINAL 
ON THE LSI-11 CONSOLE TERMINAL/ AND TO FACILITATE THE TRANSFER 
OF TEXTUAL FILES TO THE UAX FROM THE LSI. 

IT ASSUMES THE FOLLOHING DEUICE CONFIGURATION! 

LIS!TT - THE LSI-11 CONSOLE TERMINAL 

LS/LP - THE TRANSMISSIONS TO THE LSI PRINTER ARE DIRECTED TO 
THE INPUT OF A UAX TT DEUICE/ UIA A MODEM OR ACOUSTIC 
COUPLER. 

UAXiTT - THE OUTPUT OF UAX TERMINAL GOES TO THE INPUT OF THE 
THE HARD COPY TERMINAL 


DATA FLOHS FROM THE LSI LS CHANNEL OUTPUT 

TO THE UAX TT CHANNEL INPUT AND 


FROM THE UAX TT CHANNEL OUTPUT 
TO THE HARD COPY PRINTER INPUT 


TO RUN THIS PROGRAM JUST TYPE RUN UAXCOM HITH THE UAX ONLINE 
AND PROPER DEUICE CONFIGURATION, THIS PROGRAM HILL 
PROMPT THE USER HITH A ?. THE USER THEN TYPES ANY NORMAL 
UAX COMMAND. THE UAX HILL ECHO BACK ON THE PRINTER 


TO TRANSMIT A FILE TO THE UAX/ THE USER TYPES AN *, 
THE PROGRAM HILL PROMPT FOR THE FOLLOHING i 

LSI DEUICE! 

LSI FILE NAME. TYPE; 

UAX DEUICE: 

UAX DIRECTORY! 

UAX FILE NAME. TYPE! 

UAX FILE UERSION: 


THE FILE HILL THEN BE TRANSMITTED. 
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TO TRfiNSHIT CONTROL-CHftRRCTER COHBINOTIONS TO THE UfiX/ TYPE 
THE ^ CHRROCTER, THEN THE LETTER. THE EQUIUALENT 
COHHR»« HILL BE TRRHSHITTED TO THE URX. 

TO EXIT THE PROGRAM TYPE !/ THE EXCLAMATION POINT. 


TABLE OF UARIABLES 


UARIABLE 

USE 

EXPLANATION 

CLINE 

ARRAY 

INPUT LINE STORAGE 

CR 

CONSTANT 

CARRIAGE RETURN 

CX 

ARRAY 

SINGLE CHARACTER ACCESS 

DLINE 

I/O ARRAY 

FILE TRANSFER ARRAY 

I 

INDEX 

DO LOOP INDEX 

ICFND 

FLAG 

CONTROL CHARACTER COUNTER 

ILADDR 

INPUT 

LS CHANNEL ADDRESS 

IX 

SCRATCH 

CX EQUIUALENT 

J 

INDEX 

DO LOOP INDEX 

K 

SCRATCH 

INTERMEDIATE UALUE 

K1 

SCRATCH 

INTERMEDIATE UALUE 

K2 

SCRATCH 

INTERMEDIATE UALUE 

KP 

INDEX 

COUNT IN UAXF ARRAY 

LSIDEU 

ARRAY 

INPUT LSI DEUICL NAME 

LSIF 

ARRAY 

CALCULATION 

L3IFNT 

ARRAY 

INPUT FILE MAKE. TYPE 

NCHAR 

COUNTER 

NUMBER OF CHARACTERS ON LINE 

NCHRCL 

COUNTER 

NUMBER OF CHAR CURRENT LINE 

NCI 

COUNTER 

INPUT LINE CHARACTER COUNT 

NC2 

COUNTER 

INPUT LINE CHARACTER COUNT 

NC3 

COUNTER 

INPUT LINE CHARACTER COUNT 

NC4 

COUNTER 

INPUT LINE CHARACTER COUNT 

NC5 

COUNTER 

INPUT LINE CHARACTER COUNT 

NC6 

COUNTER 

INPUT LINE CHARACTER COUNT 

UAXDEU 

ARRAY 

INPUT UAX DEUICE NAME 

UAXDIR 

ARRAY 

INPUT UAX DIRECTORY NAME 

UAXF 

ARRAY 

CALCULATION 

UAXFNT 

ARRAY 

INPUT FILE NAME.rv'PE 

UAXFUR 

ARRAY 

UAX FILE UERSION NUMBER 

YORN 

INPUT 

ALPHA 'Y' OR 'N' 


INTEGER*2 IX. CLINE< 136) . YORN 

LOGICAL*! LSIDEy<4).LSIFNT<ll).UAXDEU<4).UAXDIR<15).CX<2>.CR. 
I UAXFNT< ID. UAXFUR<2) . LSIF< 16) . UAXF<35) . DLINE< 137) 

EQU I UALENCE < CL 1 NE . DL I NE ) . < I X . CX ) 

DATA CR.LSIF<16)/"15.0/ 

DATA I LADDR/" 176504/ 


HELCOHE USER 
HRITE<7.901) 


REQUEST INFORMATION OPTION 


40 HRITE<7.902) 
HRITE<7.905) 
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READ <5.803>END-4d> YORN 
IF<VOR'N.NE, 'Y') GO TO 50 
WRITE(7.903) 

HRITE<7,918> 

HRITE<7,9H> 

HRITE<7.915> 

HRITE<7.916> 

HRITE<7,917> 

HRITE<7.918> 

WRITE<7>919) 

HRITE<7.920) 

HRITE<7,921) 

HRITE<7.922> 

HRITE<7.923) 

50 KRITE(7.926> 

SEND 6 CR'S TO ALERT UAX 
DO 90 >1^6 

90 CALL PRINTL<1/CR/ILADDR) 


BEGIN PROGRAM LOOP> PROMPT USER 


100 HRITE<7,905) 

NCHRCL*0 

READ <5/ 811. END-100, ERR=101) NCHRCL. <CLIN£< J>. J»1.NCHRCL> 
GO TO 110 

101 NRITE<7.904) 

GO TO 100 

110 ICFLG-0 

CALL SCCA<ICFLG> 

IF<ICFLG.EQ.0) GO TO 150 

NCHRCL-2 

CLINE<1>-'^" 

CLINE<2)«'C' 


! TO EXIT 

150 IFCCLINE<i>.EQ.lH!> GO TO 1000 


♦ TO TRANSFER FILES 
IF<CLINE<1>.EQ.1N*> GO TO 2000 


ASSUME UAX COMMAND. PROCESS 

NCHAR=HIN0< 136. MAX0<0. NCHRCL) > 

200 IFCNCHAR.LE.O) GO TO 900 

IF<CLINE(NCHAR).NE.' O GO TO 201 

NCHAR-NCHAR-l 

GO TO 200 


HAP TO CONTROL-CHARACTERS 


201 ICFND-0 

DO 250 I-l.NCHAR 
IFCCLINECD.NE. GO TO 250 
K-NCHAR-I 
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ICFND-ICFND+l 
1F<K.NE.0> CO TO 210 
CLINE<I)-' ' 

GO TO 250 
2i0 1X-CLINE<I-^1> 

CLINE<I>-0 
DO 220 >1.26 

IF<CX<1).NE.<"100+J)) GO TO 220 
CX<l>-J.flN0."77 
CX<2)-"00 
CLINE<I>-IX 
220 CONTINUE 

IF(<I+1).NE.NCH«R) GO TO 230 
CLINE<I+1>»' ' 

GO TO 250 
230 Kl-I+1 

K2-NCHNR-1 
DO 240 J-K1.K2 
240 CLINE<J)-CLINE01> 

250 CONTINUE 

NCHAR-NCHflR-ICFND 
IF<NCHNR.LE.0> GO TO 900 
DO 260 I-l.NCHRR 
IX-aiNEU) 

DLINE<I>-CX<1> 

260 CONTINUE 

NCHflR»NCHfiR+l 

DLINE<NCHflR>-CR 


TRANSMIT LINE TO UOX 

CALL PRINTL<NCHAR.DLINE.ILADDR> 
GO TO 100 


TYPE ONLY CARRIAGE RETURN 

900 CALL PRINTLU.CR.ILADDR) 

GO TO 100 


! TO EXIT 


1000 CALL EXIT 


♦ TO TRANSFER A FILE 


2000 NC1»0 

DO 2105 >1.4 
2105 LSIDEU<J)»' ' 

2110 HRITE<7.906> 

READ (5.811.END=2111.ERR=2110) NCI . CLSIDEU< J> . >1 . 4) 

2111 NC2*0 

DO 2115 >1.11 
2115 LSIFNT(J>»" ^ 

2120 WRITE<7.907) 

READ <5.811.END=2120.ERR=2120) NC2. <LSIFNT< J> . >1 . 1 1 
NC3-0 

DO 2125 >1.4 
2125 UAXDEU<J>=" ' 
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2130 WRITE »:7, 908) 

RERD (5.811. EHD-213I/ERR-2130) NC3. <UWXDEU(J).>1.4> 

2131 NC4-0 

DO 2135 J-1.15 
2135 UfiXDlR<J)»" ' 

2140 WRITEC7.909) 

READ <5. 811. END-2141. ERR-2140) NC4. <UAXD1R(J>. J«1 . 15) 

2141 NC5-0 

DO 2145 J-1.11 
2145 UAXFNT(J)-' " 

2150 WR1TE(7.910) 

READ <5. 811. END-2150. ERR-2150) NC5. (UAXFNT(J). J-1. 11) 
NC6-0 

DO 2155 J-1.2 
2155 UAXFUR(J)-' ' 

2160 WRITE<7.911) 

READ <5. 811. END-2161. ERR-2160) NC6. <OAXFUR(J). J-1.2) 
OPEN LSI FILE 


161 DO 2165 J-1.15 
16‘J LSIF<J)-" ^ 

IF(NC1.NE.0) ENCODEO5.810.LS1F) LSIDEU.LSIFNT 
IF(NC1.EQ.0) ENCODE<11.810.LSIF) LSIFNT 
OPEN (UNIT-1 1 . NAHE-LSIF. TYPE»’'OLD" . ACCESS- 
1 ' SEQUENT I AL ' . READONLY . FORM- " FORMATTED ' . ERR-2500 > 

TYPE UAX COPY COHMfiND 


COPY TTi DEUiCDIR3FILE.TYPE.UER 


NC3-MIN0(MAX0(NC3. 0) . 4) 
NC4-MIN0(MAX0(NC4.0).15) 
NC5-MIN0(HAX0(NC5.0).ll) 
NC6-M I N0 ( MAX0 ( NC6 . 0 ) . 2 ) 
KP-1 

IF(NC3.LE.0) GO TO 2175 
DO 2170 J-1.NC3 
2170 UAXF(KP-1+J)-UAXDEU(J) 
K-NC3 

2175 IF<NC4.LE.0) CO TO 2185 
UAXF(KP)»1HC 
KF-KP+1 

DO 21S0 J-1.NC4 

2180 UAXF(KP-1+J)=UAXDIR(J) 
KP-KP+NC4 
UAXF(KP)-1H3 
KP-KP+1 

2185 DO 2190 J-1.NC5 
2190 UAXF<KP-1+J)=UAXFNT'.J) 

KP-KP+NC5 

IF(NC6,LE.0) GO TO 2215 
UAXF(KP)»1H; 

KP-KP+1 

DO 2210 J=i.NC6 
2210 UAXF(KP-1+J)=UA;^FUR<J) 
KP-KP+NC6 
2215 KP-KP-1 
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EWC0DE^KP♦5,912/DLINE> vyfiXF<J>, J-l , KP> 

KP-KP+10 

CUNE<KP>«CR 

CfiLL PR1NTL<KP,DLINE,IL<^DDR> 

NOH TRANSMIT THE DATA FILE; LINE BY LINE 


REMIND n 

2300 READ <n;8U;END«2400;ERR-2600> NC; <DLIHE<:J>; J>1;NC> 
NC>HAXe< 1 ; HIN0< 130; NO > 

DLINE(NC<*>1)>CR 

CALL PRINTL<NC-t>l;DLINE;ILADDR> 

GO TO 2300 
2400 CLOSE<UNIT-U> 

CALL PRINTL<1;"32;ILADDR> 

GO TO 100 


2500 HRITE<7;913) 

GO TO 100 
2600 NR1TE<7;924> 

GO TO 2400 
801 FORMAT <1H+) 

803 FORMAT <A1) 

810 F0RMAT<15A1> 

811 FORMAT <Q;136A1> 

813 F0RMATaH+;136Al) 

901 FORMA r<////10X; 'THE UAX^UMS COMMUNICATION EMULATOR'// 

1 10X;'TO PREPARE FOR DATA TRANSMISSION!'// 

2 10X; ' ♦ENABLE THE DATA PATH FROM THE LSI CPU TO THE' 

3 IX; 'MODEM' 

4 /10X;' ♦ENABLE DA.,; PATH FROM MODEM TO PRINTER IF ' 

5 /20X; 'YOU WANT TO MONITOR DATA'//) 

902 FORMAT<10X;'IF, YOU WANT INSTRUCTIONS TYPE Y; IF NOT '; 

1 IX; 'TYPE N'///> 

903 FORMAT<10X;'TO USE THE UAX/UHS EMULATOR!') 

904 FORMAT <10X;'^ READ ERROR *') 

905 FORMATC' ? ';♦> 

906 FORMAT<10X;'LSI DEUICEi ',») 

907 FORMAT<10X;'LSI FILE NAME.TYPEi ';») 

908 FORMAT <1 0X ; 'UAX DEUICEi ';♦) 

909 FORMAT<10X;'UAX DIRECTORY! ';!) 

910 FORMAT<10X; 'UAX FILE NAME. TYPE: ';*) 

911 FORMAT<10X; 'UAX FILE UERCTJN! ';*) 

912 FORMAT ('COPY TT: ';35AD 

913 FORMAT <10X; 'ERROR IN OPENING LSI FILE') 

914 FORMAT<10X; 'WHEN THE QUESTION MARK PROMPT APPEARS ) 

915 FORMAT <10X;' INPUT HAY BE EITHER! ! EXIT PROGRAM') 

916 FORMAT<10X;' ♦ FILES TO SEND') 

917 FORMAT<10X;' LITERAL TEXT') 

918 FORMATaX) 

919 FORMAT<10X;'THE ! RESPONSE SIGNALS END OF INPUT TO THE') 

920 FORHAT<10X; 'PROGRAM. * RESPONSE INITIATES A SERIES OF') 

921 FORMAT<10X; 'PROMPTS AS TO WHICH FILES TO SEND. TEXT') 

922 FORMAT <10X; 'IS SIMPLY TRANSFERRED LINE 3Y LINE AS IT') 

923 FORMAT<10X;'IS ENTERED AND THE RETURN KEY IS PRESSED. ') 

924 FORMAT<10X;' ♦ ERROR WHILE READING LSI FILE ♦') 

926 FORMAT <//10X; 'BEGIN UAX/UHS SESSION'///) 

END 
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SUBROUTINE PRINTUNC.LINE. ILADDR) 
IHTEGER«2 NC.ILRDDR 
L0G1CRL«I LIHE<131> 

DO lee >I>NC 

CYCLE TILL RERDY 


50 IF<<IPEEK<ILRDDR>.RND."20O>.EQ.0> GO TO 50 

PRINT CHRRRCTER 

CRLL IP0KEB<ILRDDR-^2.LINE<J>> 

100 CONTINUE 

DO 90 KK-I.3O0O0 
90 CONTINUE 
RETURN 
END 
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PROGKl^H LSICOH 


THIS IS THE UHX UERSION OF PROGRAM LSICOH. THERE 
ARE TWO PROGRAMS IN THE LSICOH SYSTEM WHICH IS 
DESIGNED TO ENABLE FILE TRANSFER FROM THE UAX BACK 
TO THE LSI'S. THIS OERSION HADE TO RUN ON THE 
UAX ACCEPTS THE FILE NAhiES FOR TRANSFER AND 
RUNS THE LSI UERSION OF THE PROGRAM. 

TABLE OF UAR TABLES 


UARIABLE USE 


FILE<40> UECTOR CONTAINING NAME OF UAX FILE 

NC NUMBER OF CHARACTERS IN FILE NAME 

J INDEX UARIABLE 

FILE2<40) UECTOR CONTAINING NAME OF LSI FILE 

LINE<131) UECTOR CONTAINING LINE OF TEXT 


L0GICAL>«1 LINE<131>/FILE<40>.FILE2(40> 


WELCOME USER 

TYPE 10 
TYPE 16 

ACCEPT 14 

NAME OF THE UAX FILE TO BE TRANSFERRED 
100 TYPE 17 

ACCEPT 15.NC,<FILE<J).1=1.NC> 

FILE<NC+1>»0 

OPEN< UNI T=1 . NAME=FIL£. IYPE='0LD ' > ACCESS®' SEQUENTIAL > 

1 FORM® 'FORMATTED' > DISPOSE® 'KEEP' , CARR I AGECONTROL®' FORTRAN' , 

2 REC0RDSIZE®131.ERR®190) 

GO TO 1000 

190 TYPE ' ERROR IN FILE NAME, RETRY' 

GO TO 100 
1000 CONTINUE 

NAME OF THE LSI FILE TO RECEIUE 
TYPE 19 

ACCEPT 15,NC,<FILE2<J)>J=l.NO 
TYPE 18 
ACCEPT 14 

EXECUTE LSI PROGRAM TO OPEN FilE ON LSI 

TYPE RUN LSICOH' 

DO 111 J® 1.500000 
111 CONTINUE 

TYPE 13.(FILE2<J).J=1.NC) 

DO 222 J® 1.500000 
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222 CONTINUE 


TYPE OUT LINES OF UfiX FILE FOR LSI TO COPY 

2061 RERD<l<ll/END-30Oe> NC. <LINE<J). J>l>NO 
TYPE 13, <LINE<J),J»1,NC) 

DO 333 >1,15000 
333 CONTINUE 
GO TO 2001 
3000 CONTI lUE 

ISSUE FILE TERMINATOR TO LSI AND REASSIGN TT TO THE CRT 

TYPE ♦,"####" 

DO 444 >1,30000 
444 CONTINUE 

TYPE •«',"RUN TTY' 

DO 555 >1,30000 
555 CONTINUE 
TYPE 20 
CALL EXIT 


10 FORMAT</' HELCOHE TO PROGRAM LSICOH: UAX TO LSI TRANSFER', 

1 ' SYSTEMS 

11 FORMAT <Q,80A1> 

13 FORMAT<1X,80A1> 

14 FORMAT (IX) 

15 FORHAT<Q,40A1) 

16 FORMAT</" SET THE RS-232 JUNCTION SWITCHES SO THAT'/ 

1 " THE DATA PATH BETWEEN THE TERMINAL AND THEV 

2 ^ HODEri IS ENABLED IN BOTH DIRECTIONS' 

3 //" AND TYPE RETURN TO CONTINUE',#) 

17 FORHAT</' NOW ENTER THE UAX FILE NAME TO BE TRANSFERRED' 

1 /•' TO THE LSIi ',#) 

18 FORHAT</' NOW ENABLE THE DATA PATH FROM THE MODEM TO'/ 

1 ' THE LSI CPU.'/ 

2 /' THEN TYPE "RUN TTY" ON THE LSI TERMINAL'/ 

3 /'AND TYPE RETURN TO CONTINUE',1) 

19 FORHAT</' NOW TYPE THE NAME OF THE LSI FILE TO RECEIUE' 

1 /' THE UAX FILE! ',#) 

20 FORMAT</' TO RESUME NORMAL LSI OPERATION SET SWITCHES' 

1 /'ON JUNCTION SO THAT THE TERMINAL TO CPU PATHWAY'/ 

2 'IS ENABLED IN BOTH DIRECTIONS'/ 

3 /'TO RESUME UAX COMMUNICATION ON THE DECWRITER' 

3 / ■■ ENABLE THE PATHWAY BETWEEN THE TERMINAL AND THE ' 

4 /' CPU IN BOTH DIRECTIONS' 

5 //' NOTE! TO USE THE PRINTER IT WILL BE NECESSARY', 

6 ' TO REBOOT SYSTEM') 

END 


FRoGRfiH LSI COM 


C 

C THIS PROGRfiM COPIES FILES FROM THE 


C LSI TT TO fl NfiMED FILE 

C 

C TPBLE OF UARIHBLE3 

C 

C OHRIRBLE USE 

C 

C LINE<131) UECTOR CONTRINIHG LINE TO BE COPIED 

C FILE<40) NAME OF THE LSI FILE 


C NC 

C I 

C 


NUMBER OF CHARACTERS PER LINE 
INDEX UARIA6LE 


C 

LOGICAL*! LINE<131).FILE<40) 

C 

C ENABLE LONER CASE LETTER TRANSMIGSruN 

C 

CALL I POKE < " 44 . " 40000 . OR . I PEEK ( " 44 ) > 

TYPE 14 

C 

C READ IN NAME OF LSI FILE 

C 

100 REhD<5. 15>NC,<FILE<J).J»1,NC) 

IF(FILE<1>.EQ.' '.OR.NC.EQ.0)GO TO 100 
FIL£<NC+1>»0 

OPEN < UN I T»2 . NAME=F I LE . TYPE= ' MEW " . ACCESS* 

1 'SEQUENTIAL ' . FORM* 'FORMATTED' . DISPOSE* 'KEEP' , 

2 CARR I AGECONTROL*' FORTRAN') 

C 

C READ IN EACH LINE IGNORING BLANK ONES 

C 


1000 READ(5. 1 1 / END*30O0)NC/ (LINE< J) . J*1 . NC) 

IF(NC.EQ.0)GO TO 1000 
C 

C TERMINATE COPY WHEN THE FIRST FOUR CHARACTERS 

C OF A LINE ARE ALL * SIGNS. 

C 

1010 IF<LINE<1).EQ. '#'.AND.LINE<2).EQ. . AND.LINE<3) .EG). '#' 
1 .AND.LINE<4).EQ.'«')G0 TO 3000 

WRITE':2.13)<LINE<J).J»1.NC) 

GO TO 1000 
3000 CALL EXIT 


C 

C 

11 F0RMAT<Q.131A1) 


13 F0RMAT<131A1) 

14 FORMAT <■' NAME OF THE LSI FILE TO BE CREATED! 

15 FORMAT<Q.40A1) 

END 


CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCrCCCCCCCCCCCCCCCCCCCCCCuuCCC 

c 


TECHNOLOGY INCORPORATED 
LIFE SCIENCES DIUISION 
DEPARTMENT OF riOHATHEHATICS SERVICES 




PROGRAM NAHEi TTY 

AUTHOR! WILLIAM G. CROSIER 

DATE! 30 SEPTEMBER 1981 


COMPUTER SYSTEM! 
OPERATING SYSTEM 


.LSI-1 I, UAX-1 1/780 
.RT-llv4, UAX/UMS 


COMPILING SEQUENCE! 


LSI! MACRO TTY/LIST/CR 


LINKING SEQUENCE: 


LSI: LINK TTY 


•= E'ZCUTION SEQUENCE: RUN TTY “ 

> 4 '' ‘ 4 * . 4 ' * 4 ^* 4 ** 4 ‘*^* 4 ** 4 »» 4 »« 4 ' * 4 ^* 4 ** 4 * ^ 


CCCCCCC-CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
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.TITLE TTY— CHANGE CONSOLE TERMINAL 
. PROGRAM TO SNITCH BETWEEN REGULAR AND ALTERNATE CONSOLE TERMINAL. 
; ONLY ONE TERMINAL IS ACTIUE AT ANY GIUEN TIME. EACH TIME THIS 
; PROGRAM IS RUN, CONTROL IS TRANSFERRED TO THE OTHER TERMINAL. 


; WRITTEN BYi WILLIAM G. CROSIER 
; DATEi 15 JULY 1980 


.MCALL .EXIT 
NRHCSR- 177580 
NRMUEC>60 
ALTCSR- 176500 
ALTUEC-340 

ABITMP-326+<ALTUEC/20> 


; NORMAL TERMINAL ADDR. 

; NORMAL UECTOR ADDR. 

; ALTERNATE TERMINAL ADDR. 
;ALT. UECTOR ADDR. 

;ALT. UECTOR BIT MAP LOC. 


CHANGE: 


ALTMSK-360/ < < 15 . ♦< ALTUEC-<20*< ALTUEC/20»>/8 . >♦ 1 > 

;BIT MASK FOR PROTECTING ALT. UEC. 


HOU 0«54,R0 

CHP #NRHCSR,304<R0) 

BNE REGTRH 

MOU 0«NRHUEC , 0»ALTUEC 

HOU 0«NRHUEC+2,0#ALTUEC+2 

HOU 8«HRHUEC-«'4 , 06ALTUEC4-4 

MOU 0«NRHUEC-«-e , 0«ALTUEC-«-6 

CLR 0«NRMCSR 

CLR 0#NRMCSR+4 


;PUT RHON ADDR. IN R8 
; ALTERNATE TERMINAL IN USE? 

;IF SO, SWITCH TO REGULAR TERM. 
.CHANGE UECTOR ADDRESSES FOR 
; ALTERNATE TERMINAL. 


.-DISABLE NORMAL TERM. 


; CHANGE DEUICE ADDRESSES FOR CONSOLE TERM. IN MONITOR: 


HOU 

#ALTCSR,304<R0> 

;KB CSR ADDR. 

HOU 

#ALTCSR+2,306<R0> 

;KB INPUT BUFFER 

HOU 

#ALTC3R*4,31O<R0> 

; PRINTER CSR 

HOU 

#ALTCSR+6,312<R0) 

.PRINTER BUFFER 

6ISB 

»ALTHSK,ABITHP<R0) 

;3ET LOH-HEHORY BIT MAP 

:Tn PROTECT ALTERNATE TERMINAL. 

BR 

RET 


REGTRH: HOU 

e*ALTUEC,0«NRMUEC 

; SWITCH UECTOR ADDRESSES FOR 

HOU 

e#ALTUEC+2, e#NRMUEC+2 

; REGULAR TERMINAL. 

HOU 

0»ALTUEC+4, e«NRHUEC-»-4 


MOU 

e«ALTUEC-»-6, ettNRHUEC+6 


CLR 

e«ALTCSR 

; DISABLE ALTERNATE TERM. 

CLR 

06ALTCSR+4 



. CHANGE DEUICE 

ADDRESSES BACK FOR 

HOU 

4NRHCSR,304<RO) 

HOU 

«NRHCSR-*-2,306<RO> 

MOU 

«NRHCSR>4,310<RO> 

MOU 

»NRHCSR-»-6,312<R0> 

BIC6 

#ALTHSK,ABITHP<R0) 

RET: .EXIT 


.END 

CHANGE 


NORMAL TERMINAL: 


; UNPROTECT ALTERNATE TERM. 
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C. DICTIN - PROGRAM LISTING 
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CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 

c 

:»{ :f< ^ :4c|( 

tK ;«( 

;♦< .4! 

=«< TECHNOLOGY INCORPORATED ♦ 

LIFE SCIENCES DI0I3I0N ^ 

=•* DEPARTMENT OF BIONATHEHATICS SERUICES ♦« 

14C 

;♦< :♦< 

;fi :4::f:;4{:4: :4: :f: :4i :4< ^ ^ ^ ‘4-fi ^ sf ^ :4« ^ i«c^ :4: ^ 4c:|{ :4< 4: ^ ^ ^ :4: ^ i4 : ^ ■¥ f- 4: :4^'4 4: .f ^f. 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


PROGRAM NAME i 

DESIGNER/ ANALYST I 

PROGRAMMER i * 


.DICTIN 

.CRAIG E. LITTON 
.SCOTT G. THOMPSON 


DATEi .30 SEPTEMBER 1931 


COMPUTER SYSTEM; LSI-11. UAX-11/730 

OPERATING SYSTEM; RT-llv4. UAX.UMS 


COMPILING SEQUENCE; 

LSI; REMOUE CLSI COMMENTS 

CREATE FI LEI; MAIN. LCASE 
CREATE FILE2; COPYA.COPYD.COPYM.COPYE.FETCH 
UALNAH. OUF'^LP . REPORT. HANG 
CREATE FILES; ELEMNT.ELuUAL.RECRDR 
COMPILE SEPERATELY; FORTRAN FILEN 


¥ 

♦ 

:¥ 

♦ 

♦ 

5f 

-4< 

♦ 

'•¥ 

i¥ 

:4t 

t 

-^45 

■¥ 

i¥ 

!¥ 

'4- 

i¥ 

4i 

i¥ 


UfiX 

REHGviE CUflX COHHENTS 
COHPILE; F0RTRfiN/N0I4 DICTIN 

:4c 

.4: 

:4c 

4‘. 

LINKING 

SEQUENCE ; 

:4c 

:4c 

:4c 

LSI 

i L I NK/PROHPT/ EXECUTE; DICTIN FI LEI 
+FILE2/0: 1/C 
*FILE3/0;1// 

•4c 

:4< 


; LINK DICTIN 

4c 

:4c 


M 

4^ 

:♦* 

’•¥ 

■¥ 

:¥ 

¥ 

•¥ 

4c 

;4: .4 ;4c ¥ ‘¥‘¥ •¥ 4: :4: 4' :f: 4i ;4c :4c :4 :4: :4: -4: 4- :4: :4: :4 :4c :4: :f‘ :4: 4: :4::*: :4 .4; :4c -¥ :¥ -4: :4c :4c :4c :4c :4c .4: :4c 4c :4c 4: -4c :4: :4 : •¥ 4c ;t: :4: :4: :4c 4'^ :4: . 4 :4c :4 f :4c:4. 
:4;;4c:4c:4cf‘:4c;4cc4c:4<;4c:4c:4<:4c:4c:4c;4c:4‘:4<:4c:4<:4‘;4c;^cc♦<:4::4c:4«c4^•fcc^•;4:c4<:♦<c4c:4c:4«c4c:4c:4c:4c;4cc4<:4cc4cc4c:4<c4«:4c•4ic4cc4{:4<c4<:4t.4^:^c:4c:4::♦c:4c:4c;^ 


EXECUTION SEQUENCE; RUN DICTIN 


C 

c 
c 
c 
c 

CCLCCCCCCCCCCCCCCCCCCClCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
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:4c 

:4c 

•4c 

:4c:4::4::4c:4;:4c 
.* fC*i:¥‘-¥'^¥ 


ooooo ooo ooooooooonooonooo oooooo OOOOOOOOOOOOOOOOOOOOOOOOOOO 


PROGRAM DICTIN 


TECHNOLOGY INCORPORHTEO 
LIFE SCIENCES DIUISION 
16821 BUCCPNEER^ SUITE 206 
HOUSTON, TEXAS 77053 

AUTHOR) SCOTT G. THOMPSON 
DESIGNER/'ANALYSTi CRAIG E. LITTON 
DEPARTMENT OF BIOMATHEMATICS 
28 APRIL 1981 


THIS PROGRAM IS DESIGNED TO CREATE AND MAINTAIN A DICTIONARY 
FILE FOR DATA HHICH IS STORED IN A HIERACHIAL STRUCTURE OF 
FORMS AND ELEMENTS. 


DICTIONARY - CONTAINS A MAXIMUM OF FIFTY FORMS ACCESSED BY 
NAME. 

FORM - CONTAINS A MAXIMUM OF lOO ELEMENTS HHICH ARE 

ACCESSED BY NAME INSIDE OF RESPECT I UE FORMS. 

ELEMENT - KEY TO HOH THE ACTUAL DATA HAY BE rOUND. 

THE MASTER DICTIONARY HEADER RECORD IS THE FIRST INFORMATION 
FOUND IN THE FILE. IT IS FOLLOHED BY THE FORMS. 

EACH FORM HAS A HEADER RECORD, IT IS STRUCTURED 
AS FOLLOWS) 

FNAHE<10) * THE NAME OF THE FORM 

ID<10> » THE IDENTIFICATION, IF PRESENT 

IDSTCL * THE USER SPECIFIED STARTING COLUMN OF THE ID 

IHIDTH » THE PROGRAM CALCULATED WIDTH OF THE ID NAME 

NUHELS = NUMBER OF ELEMENTS IN THE FORM 


THE INFORMATION CONCERNING THE UP TO 100 ELEMENTS IN EACH 
FORM IS ARRAYED AS FOLLOWS) 


ENAMES(100, 10) » ARRAY OF ELEMENT NAMES IN FORM 
ESTCOL<100) » USER SUPPLIED STARTING COLUMN FOR 


EWIDTH<100) 

ETYPE<100) 

DPLACEa00) 

DESC<100,40) 


THE ELEMENT 

USER SUPPLIED ELEMENT WIDTH 
TYPE OF THE ELEMENT <A,I,X,F) 

IF F TYPE, NUMBER OF DECIMAL PLACES 
ARRAY OF ELEMENT DESCRIPTIONS 


THE MASTER HEADER AND ONE FORM CONTAINING ITS ASSOCIATED 
ELEMENT DESCRIPTORS IS wfliHTAINED IN CORE AT ONE TIME. AFTER 
A NEW FORM COMMAND IS SELECTED, A NEW FORM IS READ IN OFF THE 
STORAGE DEUICE AND THE OLD MODIFIED FORM IS WRITTEN TO THE 
SCRATCH FILE. THE SCRATCH FILE IS REWRITTEN TO THE PERHENANT 
FILE BY DELETING THE FILE FROM ITS LOCATION AND CONDENSING. 
THE NEW FILE IS APPENDED AT THE END OF THE DICTIONARY AND THE 
MASTER HEADER IS LIKEWISE REORDERED, 
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C TO CALCULATE THE ADDRESS OF ANY FORM IT IS NECESSARY TO KNOW 

HOH HANY ELEHENTS ARE IN EACH FORH. LOGICALLY THE PROGRAM MILL 
CONSIDER THE MASTER HEADER A RECORD AND EACH FORM HEADER AND 
ELEMENT HEADER HILL ALSO BE SEPERATE RECORDS. 


TABLE OF UARIABLES 


UARIABLE 


USE 


C 

DFLAG 

ECOH 

FCOM 

I 

IDOHN 

IDSTCL 

lEND 

IFLAG 

IFOUND 

II 

INITAL 

ITEST 

lUP 

IHIDTH 

J 

K 

KA 

KB 

M 

HEND 

MORC 

N 

NDEL 

NFORHS 

NCLEAR 

NUMELS 

TOOL 

TELS 

TEND 

THIDTH 

T 

H 


COLUMN NUMBER 

POINTER FOR RECORD DELETION 
ELEMENT COMMAND 
FORM COMMAND 
INDEX UARIABLE 
LOGICAL L'NIT HUMBER 
ID STARTING COLUMN 

LENGTH OF LONGEST RECORD HITHIN FORH 

ELEMENT POINTER 

SEARCH FLAG 

INDEX UARIABLE 

INITIALIZh 'ION FLAG 

INTERMEDIATE UALUE FOR lEND 

LOGICAL UNIT NUMBER 

ID HIDTH 

INDEX UARIABLE 

INDEX UARIABLE 

PRINTING INDEX 

PRINTING INDEX 

INDEX UARIABLE 

LENGTH OF LONGEST RECORD HITHIN FORM 

MODIFY COMMAND 

MODIFY OR CREATE DICTIONARY 

INDEX UARIABLE 

DELETION POINTER 

NUMBER OF FORMS IN DICTIONARY 

INITIALIZATION INDEX 

NUMBER OF ELEHENTS IN A FORM 

TEMPORARY FOR IDSTCL 

TEMPORARY FOR NUMELS 

TEMPORARY FOR I END 

TEMPORARY FOR IHIDTH 

TYPE 

HIDTH 


ARRAY 


USE 


CENAME<ie> 

CFNAMECIO) 

DESC<10O>4O> 

DPLACE<100) 

ENAHES<1OO>10> 

ESTCOL<100> 

ETYPE<100) 

EHIDTH<10O> 

FILE<30) 

FNAHE<10) 

FNAHES<50. 10> 

FNTRAN<50,10> 


CURRENT ELEMENT NAME 

CURRENT FO.-M NAME 

ELEMENT DESCRIPTIONS 

NUMBER OF DECIMAL PLACES FOR F TYPE 

ELEMENT NAMES 

ELEMENT STARTING COLUMNS 

ELEMENT TYPES 

ELEMENT HIDTHS 

NAME OF THE DICTIONARY FILE 

FORM NAME 

ALL FORM NAMES 

INTERMEDIATE STORAGE FOR FNAMES 
35 


C 

IDU0) 

FORM ID 

C 

IP<10O) 

TEMPORARY FOR DECIMAL PLACES 

c 

IT<100) 

TEMPORARY FOR TYPES 

c 

ITCOL<100) 

TEMPORARY FOR ELEMENT STARTING COLUMNS 

c 

ITN<100) 

TEMPORARY ELEMENT NAMES 

c 

IH<100) 

TEMPORARY HIDTHS 

c 

ITEHP<10) 

TEMPORARY FORM NAME 

c 

TDESC<10O,40) 

TEMPORARY FOR DESCRIPTIONS 

c 

TENAH<1O0,10) 

TEMPORARY ELEMENT NAMES LIST 

c 

TNAHE<10) 

TEMPORARY FOR FNAME 

c 

TPLACE<10O) 

TEMPORARY FOR DPLACE 

c 

TTYPE<100) 

TEMPORARY FOR ETYPE 


c 

c 

c 

c 

INTEGER*2 NFORMS/ IDSTCL. IHIDTH,NUHELS/ESTCOL<10O>,EWIDTHa00>, 

1 DPLRCE<100>.DFLRG 
C 

LOGICAL*! FNAHES(50, 10>>FNRME<!0>/ ID<10>/ENAHES<10e/ 10>.ETVPE<!00> 

1 , DESC< 100,40) , MORC, FCOH,CFNflME< 10) , YORN, ITEHP< 10) , CENAHE< 10) 

2 , FNTRAN<50, 10) ,FILE<30) , IUfiLUE< 10) , INST, RDEST 
COMHON/ELEC/NFORHS, IDSTCL, IHIDTH, NUHELS, ESTCOL, EHIDTH, DPLfiCE, 

1 FNAMES,FNAHE, ID,ENAHES,ETYPE,DE£C,DFLAG, lEND, lURLUE 
COMHON/UNITS/IUP, IDOHN, I STOP 
COHMON/REUSE/IXDUH<3200) 

CUAX EXTERNAL FINIS 

C 

c 

C OPEN FILES! 

C 

C UNIT FILE USE 

C 1 DICT.DAT PERMENANT DICTIONARY FILE 

C 2 XXXX.XXX TEMPORARY SCRATCH FILE 

C 
C 

OPEN < UN I T-2 . NAHE= ’ XXXX . XXX ' , TYPE= ' SCRATCH ' , ACCESS* 

1 ' SEQUENTIAL" , FORM- "FORMATTED " , D I SPOSE* " DELETE " , 

2 CARR I AGECONTROL* " FORTRAN " , RECORDS 1 2E-70 > 

C 

C 

C INITIALIZE 

C 


c 

CLSI 

LPUNIT»7 

CUAX 

CALL USEREX(FINIS) 

CUAX 

LPUNIT-6 


ISTOP-0 


FILE(30)»0 

NFORMS-0 

IDSTCL*0 

IHlDTH-0 

NUMELS«0 
NDEL»0 
IUP»1 
ID0NN*2 
INITAL*0 
REHIND 1 
REHIND 2 
DO 1 1*1,30 
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1 FILEa/-' ' 

c 

C HELCOHE USER 

C 

4 HRITE<LPUNIT,801) 

READ <5/901. END«4 . ERR*4 > HORC 
CALL LCASE<HORC> 

IF<.NOT.<HORC.EQ.'M'.OR.HORC.EQ.'C'>)GO TO 4 
3 HR!TE<LFUNIT/848) 

READ<5/ 915/ END-3/ ERR-3)N, <FILE< J) / J-1 / N) 

FILE<N+1)«0 

NDICT-N 

8 HRITE<LPUNIT/857) 

READ<5/ 901 > INST 
CALL LCASE<INST> 

IF<INST.EQ.'S'.OR.INST.EQ.'L')oO TO 9 
GO TO 8 

9 IF<MORC.EQ. H"> 

1 OPEN<UNIT■l/NAME•FILE/TYPE•'OLD^ACCESS•■'SEQUENTIAL' / 

2 FORM- " FORMATTED " / DISPOSE- " KEEP ' / CARR I AGECONTROL- ' FORTRAN " / 

3 REC0RDSIZE-70/ERR-4) 

IF<MORC.EQ.'M') GO TO 40 
IF<MORC.NE. 'C')GO TO 4 

OPE N< UN I T- 1 / NAME-F I LE / TYPE- ' NEH ^ ACCESS- " SEQUENT I AL ' / 

1 FORM-'FORMATTED"/DISPOSE-''KEEP'' /CARRIAGECONTROL-'FORTRAN'/ 

2 RJCORDSIZE-70/ERR-4) 

INIThL-1 

GO TO 50 
C 

C HRITE OUT BLANK DICTIONARY FOR CREATION 

C 

2 DO 5 J-1/ 50 
DO 10 1-1/ 10 
10 FNAMES<J, I>-' " 

5 CONTINUE 
INITAL-0 
NFORMS-0 
GO TO 60 

C 

C 

C 

40 REMIND 1 
REMIND 2 

READ<1/905>NFORMS 

READ< 1 / 910X<FNAMES< I/J>/J=l/10> / 1-1/50) 

MRITE<2/905)NFORHS 

NRITE<2/910)<<FNAMES<I/J)/J»1/ 10)/ I-*l/50> 

DO 49 I-l/NFORHS 

READ<1/907)<FNAME<J)/J»1/ 10)/ <.ID<J)/ J-1/ 10)/ IDSTCL/ INIDTH/ 

1 <IUALUE<J)/J-1/10)/NUMEL3/IEND 

NRITE<2/907)<FNAME(J)/J-1/ 10)/ <ID<J)/ J-1/ 10)/ IDSTCL/ IHIDTH/ 

1 <IUALUE<J>,J»1/10>/NUMELS/ lEND 
DO 47 J-l/NUMELS 

READ<1/911><ENAHES<J/K)/K-1/10)/ESTCOL<J)/EMIDTH(J)/ETVFE<J) 

1 /DPLACECJ)/ "DESC<J/K)/K»l/40) 

NRITE<2/911)<E1AMES<J/K)/K»1/10)/ESTCOL<J)/EWIDTH<J)/ETVPE<J) 
1 /DPLACE<J)/<DESC(J/K)/K»l/40) 

47 CONTINUE 
49 CONTINUE 
I UP-2 


CUAX 

CL3I 

CLSI 

CLSI 

CLSI 

CLs: 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 

CLSI 
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CLSI I DOWN- 1 

CL3 1 CLOSE < UNI T« 1 / D I SPOSE- ^ DELETE ' > 

CLS I OPEN< UN I T- 1 . NflHE«F I LE / TYPE- ' NEH ' > fiCCESS- " SEQUENT I flL ' ; 

CLSI 1 FORM- "F0RH«T FED", DI SPOSE- 'l;EEP^CflRRIfiGECONTROL- FORTRAN', 
CLSI 2 RECORDSIZE-70) 

REINTIALIZE STORAGE BUFFERS EACH FORM PASS 

se 00 91 i-i,ie 

FNAHE<I)-' ' 

ID<I>-' ' 

IUALUE<I)-' ' 

91 CONTINUE 
IDSTCL-e 
IHIDTH-e 
NUHELS-e 
DO 92 1-1,100 
DO 93 >1,10 
93 ENAHES<I,J)-' ' 

ESTCOL<I>-0 
EHIDTH<I)-0 
ETVPE<I)-' ' 

DPLACE<I)-0 
DO 94 >1,40 
54 DESC(I,J)-' ' 

52 CONTINUE 

IF<INITAL.EQ.1)G0 TO 2 

ACCEPT FORM COMMAND 

60 IF<INST.EQ. 'L')HRITE<LPUNIT,802) 

IF<INST.EQ. 'S')WRITE<LPUNIT,858> 

READ<5,901>FCOM 
CALL LCASE<FCOH> 

DO 70 1-1,10 
70 CFNAME<1)-' ' 


IF<FCOM.NE.'A'> GO TO 200 


ADD FORM COMMAND 


IF<NFORMS.EQ.50>GO TO 195 
90 HRITE<LPUNIT,803> 

READ <5,914, END-90 , ERR-90 > N , < CFNAHE < I ) , I - 1 , 1 0 ) 
IF<CFNAME(1).EQ.' ')G0 TO 90 
IF<N.GT.10)HRITE<LPUNIT,846XCFNAHE<I>, 1-1,10) 
CALL UALNAM < CFNAHE , FNAHES , NFORHS ,NEW,LPUNIT) 
IF<NEW.EQ.1)G0 TO 95 
HRITE<LPUNIT,856) 

GO TO 90 
95 DO 100 K«l,10 
1 00 FNAMES < NFORMS+ 1 , K ) -CFNAHE < K ) 

CALL COPYA<IUP,IDOHN) 

NFORMS-NFORHS+1 


o n o 


BUILD FORM HERDER 

DO ISO >1.10 

150 FNRHE<J>-CFNRHE<J> 

151 HRITE<LPUHIT.804) 

RERD<5. 901 . END-lSl .ERR-ISl >YORN 
CRLL LCRSE<YORN> 

IF<YORN.NE.'Y^A^^D.YORN.NE.'NOCO TO ISl 
IF<YORH.EQ.'N')GO TO 160 

152 HRITE<LPUNlT.e05> 

RERD<S. 914. END-1S2. ERR-1S2) N. < ID< J> . >1 . 16) 

IF<ID<1).EQ.' OCO TO 152 
IF<N.GT.10)HRITE<LFUNIT.847XID<J).>1.10) 

155 HRITE<LPUNIT.306> 

RERD< 5 . * . END- 1 55 . ERR- 1 55 > IDSTCL 
IF<IDSTCL.LT.0.OR.IDSTCL.GT.5120)HRITE<LPUNIT.84O) 

IF<IDSTCL. LT.O. OR. IDSTCL. GT.S120)G0 TO 155 
1F< IDSTCL . GT . 131 >HRIT£<LPUNIT. 841 ) 

156 HRITE<LPUNIT.83S> 

RERD<5.«. END-156. ERR-156) IHIDTH 
IF<IHIDTH.LT.0.OR.IWIDTH.GT.10)HRITE<LPUNIT.S42) 

IFUNIDTH. LT.0. OR. IHIDTH. GT.10)CO TO 156 
IF<IHIDTH.GT.131)HRITE<LPUNIT.843) 
IF<<IDSTCL+IHIDTH-1).LE.5120>GO TO 157 
HRITE<LPUNIT. 849) IHIDTH. IDSTCL 
CO TO 156 

157 HRITE<LPUNIT.852) 

RERD<5. 914. END-157. ERR-157)N. < IURLUE< J) . >1 . IHIDTH) 
IF<IUflLUE<l).EQ.'' OGO TO 157 

IF<N.GT.IHIDTH)HRITE<LPUNIT.853)IHIDTH.<IVfiLUE^J).J-l. IHIDTH) 
160 NUMELS-O 
DFLRG-0 

IF<YORN.EQ.'YOGO TO 164 
DO 163 I-l.lO 
IURLUE<I)-' ' 

163 ID<I)-' ' 

IDSTCL-0 

IHIDTH-0 

IEND-0 

164 IEND-IDSTCL+IHIDTh-1 
CALL ELEHNT(INST.LPUNIT) 

DO 165 I-l.NUHELS 
ITEST-ESTCOLU )+EHIDTHU )-l 

165 lEND-MRXOaEND.ITEST) 

HRITE<lDOHN.907)<FNHME<J>.J*i.l0)XlDU)/ J-1. !'■' T )L. 

1 IHIDTH. <IUflLUE(J).>l. 10). HUHELS, I END 
DO 190 J-l.NUHELS 

190 HRITE<IDOHN.911)<ENRMES<J.K).K»1.10).ESTr .n.|IDTMU)/ 

1 ETYPE<J).DPLflCE<J).<DESC<J.K).K-1.40) 

CALL OUERLP<ID. IDSTCL. IHIDTH. ENAHES.ESTr. >TH. 

1 HUHELS) 

EHDFILE IDOHH 
REHIND IDOHH 
K- IDOHH 
IDOHH- I UP 
lUP-K 
GO TO 50 


195 HRITE<LPUNIT.83S) 
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CO TO 50 


200 IF<FCOH.NE. 'D'>G0 TO 300 

DELETE FORM COHMfiNO 

IF<NFORMS.EQ.0>GO TO 510 
205 WRITE<LPUNIT,S07) 

REflD<3. 904. END«205. ERR-205) <CFN«ME< I ) . I-l . 10> 
IF<CFNfiME<l>.EQ." OGO TO 205 

SEARCH FOR NAME IN DICTIONARY HEADER 


NDEL>0 

DO 210 I-l.NFORHS 
DO 215 J>1/10 

IF<CFNAME(J>.NE.FNAMESa.J)>GO TO 210 
215 IF(’J.EQ.10; NDEL-I 
210 CONTINUE 

IF<NDEL.EQ.0) HRITE<LPUNIT.808)<CFNAHE(I). I«l. 10) 
1FCNDEL.EQ.0)GO TO 50 

IF FORM NAilfi IN FILE HEADER. DELETE 


REWIND lUP 
REWIND IDOWN 
NF0nMS»NF0RHS-l 
K«0 

DO 250 I»1.50 
IFd.EQ.NDEDGO TO 250 
K-K+1 

DO 255 J-1. 10 

255 FNA1ES<K.J)»FNAMES<I.J) 

250 CONTINUE 

CALL COP YD < I UP . I DOWN . NDEL > 

WRITE<LPUNIT.845XCFNAHE< I >.1=1.10) 

K=IDOWN 

I DOWN" I UP 

IUP»K 

GO TO 50 


363 IF<FCOH.NE.'M') GO TO 400 


MODIFY FORM COMMAND 


IF<NFORMS.EQ.0)GO TO 510 
305 WRITE<LPUNIT. 810- 

READ < 5 . 904 . END=305 , ERR=305 ) < CFNAME < I ) . I = 1 . 1 0 ) 
IF(CFNAME<1).EQ." OGO TO 385 

90 
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c 


non o o o 


c 

c 


FIND THE FORM TO BE MODIFIED IN THE HEADER 


IFLAG-e 

DO 310 I-l/NFORHS 
DO 315 J>1>]D 

IF<CFNAHE<J>.HE.FNAHES<I/J>> GO TO 318 
315 IF<J.EQ.18)1FLPG«I 
310 CONTINUE 

IF<IFLAG.EQ.e>HRITE<LPUNIT>808)<CFNAHE<I). I>1. 18> 
IFaFLAG.EQ.e>GO TO 58 

GET THE FORM 

CALL FETCH<IUP, IFLAG> 

HR I TE < LPUN I T . 844 H FNAHE < I ) , I « 1 , 1 8 > . NUMELS 
328 HRITE<LPUNIT.811> 

READ ( 5 > 98 1 / END>328 > ERR-328 > YORN 
CALL LCASE<YORN> 

IFCYORN.EQ. 'NOGO TO 350 

CHANGE FORM HEADER INFO AND/OR MASTER KFADER 

IF<YOR^i.NE. 'YOGO TO 328 
HRITE<LPUNIT,820) <FNAHE< I ) , I»1 , 18) 

IF<ID<1).NE.' OHRITE<LPUNIT,821XIDa). 1-1/ 18),IDSTCL> IHIDTH 
1 XIUALUE<I>/>1>10) 

321 HR1TE<LPUN1T,812) 

READ < 5 . 981 . END-321 > ERR-321 ) YORN 
CALL LCASE<YORN) 

IF<YORN.EQ. 'N')GO TO 338 
IFCYORN.NEXYOGO TO 321 

322 HRITE<LPUNIT,813) 

READ < 5 > 9 1 4 . END-322 , ERR-322 ) N X CFNAME < J ) . J» 1 . 1 8 > 
IF<CFNAME<1).EQ.' OGO TO 322 
IF<N.GT.10>HRITE<LPUNIT,846)<CFNAME<J).J-1/18) 

CALL UALHAM < CFNAME . FNAMES , NFORMS > NEH / LPUN I T ) 

IF<NEH.EQ.l)GO TO 32^: 

HRITE<LPUNIT.856> 

CO TO 322 

323 DO 324 1-1,18 

324 FNAMES < I FLAG, I > -CFNAME < I ) 

DO 325 1-1,18 

325 FNAHE<I)-FNAMES<IFLAG,I) 

338 WRITE<LPUNIT,814) 

READ < 5 , 98 1 , END-338 , ERR-338 > YORN 
CALL LCASE^YORN) 

IF<YORN.EQ. ^NOGO TO 335 
IF<YORN.NE. 'YOGO TO 338 
331 HRITE<LPUNIT,815) 

READ<5, 914, END-331, ERR-331 )N, <ID<:J),J=1, 18) 
IF<N.GT.10)HRITE<LPUNIT,347XID<J), J-1, 18) 

335 IF<IDa>.NE.' •')G0 TO 336 
IDSTCL-8 

IHIDTH-8 
DO 338 1=1,18 
333 lUALUECI)-' '' 

GO TO 350 

336 HRITEaPUNIT,S51> 

READ <5, 901 , END-336, ERR=336)Y0RH 
CALL LCASE<VORN) 91 


o o n o o o n n o o o o o 


IF<YORN.EQ. 'N')GO TO 340 
IF<YORN.NE.'Y')GO TO 335 
337 HRITE<LPUNIT,316> 

RERD<5, END-337 / ERR-337MDSTCL 
IF<IDSTCL.LT.0.OR.IDSTCL.GT.5120>WRITE(LPUNIT,S4O> 
IF<IDSTCL.LT.0.OR.IDSTCL.GT.5120>GO TO 335 
IF<IDSTCL.GT.131)HRITE<LPUNIT.841> 

340 HRITE<LPUNIT,836) 

RERD<S> 901 / END-340; ERR-340>Y0RN 
CPLL LCRSE<YORN> 

IF<YORN.EQ.'NOGO TO 349 
IF<YORN.NE. 'Y')GO TO 340 
345 HRITE<LPUNIT;837) 

REflD<5;*; END-345; ERR-345)IHIDTH 

IF<IWIDTH.LT 0.OR.IHIDTH.GT.10>WRITE«;LPUNIT;842) 

IF<IWIDTH.LT.0.OR.IWIDTH.GT.10)GO TO 345 

IF<IHIDTh.GT.131)HRITE<LPUNIT;843) 

IF<aDSTCw*-IHIDTH-l).LE.5120)GO TO 349 

HRITE<LPUNIT;849>IWIDTH; IDSTCL 

GO TO 345 

349 HRITE<LPUNIT;854) 

RERD<5; 901 ; END-349; ERR-349)Y0RN 
CALL LCPSE<YORN> 

IF<YORN.EQ.'NOGO TO 350 
IF<YORN.NE. 'YOGO TO 349 
351 HRITE<LPUNIT;855) 

REPD<5; 914; END-351 ; ERR-351 )N; < lOflLUEC J) ; J»1 ; INIDTH) 
IF<IO«LUEa>.EQ.' ')GO TO 351 

IF<N . GT . IWIDTH>WRITE<LPUNIT; S53> IWIDTH; < I0fiLUE< J) ; >1 ; IWIDTH) 
HEADER HODIFICfidONS COMPLETED 

350 HEND-IDSTa+IWIDTH-1 
CALL ELEHNT<INST;LPUNIT) 

DO 380 I-1;NUHELS 

I TEST-ESTCOL < I ) +EH I DTH <1 ) - 1 
360 HEND»MAX0<HEND; ITEST) 

IF<HEND.EQ.-1>MEND*0 

CALL COPYH <1 UP ; I DOWN ; I FLAG ; MEND ) 

CALL OUERLP< ID; IDSTCL; IWIDTH; ENAHES; ESTCOL; EWIDTH; 

1 NUMELS) 

K- I DOWN 
IDOHN-IUP 
lUP-K 
GO TO 50 


400 IFCFCOM.NE. 'L')GO TO 500 


LIST COMMAND 


IFCNFORMS.EQ.0>GO TO 510 

WRITE<LPUNIT;U17) 

N-NFORMS 

H=5 
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K-N^M+1 
DO 410 1«1,K 
KB-I*M 
KA-KB-4 

kb»h;n0<kr>nforms) 

HRITECLPUNIT. 909) < <FNfiHES< 1 1 , J) / J»l > K ) , n-K«, KB> 

410 CONTi: £ 

415 MRITE<LPUNIT/818) 

RE0D(5. 901 . Ei«-415^ ERR-415)V0RN 
CALL LC0SE<YORN) 

IFvYORN.EQ. 'N') GO TO 50 
IF<YORN.NE.'YO GO TO 415 

HRNT SPEC. FORM RND/OR ELEMENT INFORMATION 

416 NRITE<LPUNIT.819) 

.^EA0<5< 904, END-416/ ERR-416) <CFNAME< I ) , I«1 , 10) 
IF<CFNAME<1).EQ.' OGO TO 416 

SEARCH FOR FORM 


lFLAG-0 

DO 420 I-l/NFORHS 
DO 425 >1/10 

IF<CFNflME<J).NE.FNAMES<I/J))GO TO 420 
425 IF<J.EQ.10)1FLAG-I 
420 CONTINUE 

IF<IFLflC.EQ.0)HRirE<LPUNIT/808)<CFNAHE<I)/I-l/10) 
IFaFLAG.EQ.0)GO TO 50 
CALL FETCH<IUP/IFLAG) 

LIST THE APPROPRIATE FORM HEADER 

WRITE<LPUNIT/820) <CFNAHE( J) />1 / 10) 
ir:iD<l).NE.' ') 

1 HRITE<LPUNIT/ 821 ) < ID< J) / >1 / 10) / IDSTCL/ IWIDTH, < lUALUEU) / >1 / lO) 
HR I TE ( LPUN I T / 322 ) NUHELS 
IF<NUMELS.EQ.0)GO TO SO 

ELEMENT NAME LISTING 


435 HRITE<LPUNIT/823) 

READ<5/ 901 / END»435/ ERR-435) YORN 
CALL LCASE<YORN) 

IF<YORN.EQ. 'N')GO TO 50 
IF<YORN.NE. Y') GO TO 435 
IF<NUHELS.NE.0)GO TO 440 
HRITE<LPUNIT/824) 

GO TO 50 

440 HRITE<LPUNIT/834KCFNAHE<J)/>1/ 10) 

N-NUMELS 

H-5 

K-N/H+1 
DO 450 I-l/K 
KB=I*M 
KA-KB-4 

KB«MIN0<KB/ NUHELS) 

HRITE<LPUNIT/909)<<ENAHES<II/J)/>1/10)/II«KA/KB) 
450 CONTINUE 


C 
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C SPECIFIC ELEMENT TO LIST 

C 

455 WRITE<LPUNIT/839) 

RE(V><5. 981 / END-455. ERR-455>Y0RN 
CALL LCOSE<YORN> 

IF<YORN.EQ. 'NOGO TO 50 
IF(YORN.NE.'Y')GO TO 455 

456 HRITE<LPUNIT.825) 

REPD<3. 904. END-456. ERR-456: <CENAHE< I > . I^. . 10> 

IF<CtN«ME<l).EQ.' ')GO TO 456 

IFOUND-0 

DO 470 I-l.NUHELS 
DO 460 >1.10 

IF<EN«MES<I.J).NE.CENRME<J))GO TO 478 
460 IF<J.EQ.10>IFOUND-I 

IF<IFOUND.NE.0>GO TO 468 
470 CONTINUE 

HRITE<LPUNIT.826XCENPHE<I>.I-1.10> 

CO TO 455 

480 HRITE<LPUNIT.827>(ENNNES<IF0UND. I>. I-l. 10> 
HRITE<LPUNIT.828> ESTC0L<IF0UND) 

HRITE<li»UNIT.829) EWIDTH<IFOUND> 

HRITE<LPUNIT.830) ETYPE<IFOUND) 
IF<ETYPE<IFOUND).NE.T')GO TO 485 
HRITE<LPUNIT.831) DP'.RCE< IFOUND) 

485 HRITE<LPUNIT. 832) <DESC( IFOUND. I ) . I-l . 40) 

CO TO 455 

500 IF<FCOM.NE. 'EOGO TO 505 
C 

C EXIT THE PROGRRH 

C 

GO TO 700 

505 IF<FCOM.NE.'ROCO TO 60 
C 

C ISSUE fl REPORT ON THE DICTIONARY 

C 

IF<NFORHS.EQ.O)GO TO 510 
IFUNST.EQ. 'L')WRITE<LPUNIT.859> 

IFdNST.EQ. 'S")HRITE<LPUNIT.860) 

RERD<5.901>RDEST 
CALL LCASE<RDEST) 

CALL REPORTCFILE.NDICT.RDEST. lUP.LPUNIT) 

CUAX GO TO 40 

CLSI GO TO 50 

C 

C ILLEGAL COMMAND 

C 

510 HRITE<LPUNIT.833> 

GO TO 60 
C 
C 
C 
C 
C 
C 
C 
C 
C 

861 FORHAT(/vvl0X. 'HELCOHE TO PROGRAM DICTIONARY VviOX. 
1 'DO YOU WISH TO '. 94 


2 ^MODIFY AN EXISTING FILE OR CREATE A NEN ONET^ 

3 //10X, PLEASE ENTER! V24X, 

4 'M - IF YOU WANT TO MODIFY OR LIST A DICTIONARY' 

5 /24X/'C - IF YOU WANT TO CREATE A NEW DICTIONARY'. 

6 //10X, 'COMMAND I ',$> 

802 FORMAT <//10X. 'SELECT A FORM FUNCTION! '//10X 


1 

'ENTER 

FOR THE FOLLOWING FORM FUNCTION'// 

2 

10X, ' A 

ADD A FORM'/10X, 

3 

•' D 

DELETE A FORM'/10X, 

4 

' E 

EXIT THE PROGRAM'/ 10X, 

5 

' L 

LIST A FORM'/10X, 

6 

' M 

MODIFY A FORM/10X, 

7 

' R 

ISSUE A DICTIONARY REPORT' 

8 

/V10X, 'COMMAND: 

',$) 


003 FORMAT </I0X. 'NAME OF THE fORM TO BE ADDEDi '.») 

804 FORMAT</10X. WILL THE FORM CONTAIN ID INFORMATION <Y/N)? .1) 

805 FORMAT </l0X. 'ENTER ID NAMEi ',$> 

806 FORMAT </I0X. 'ENTER ID STARTING COLUMNi 

807 FORMAT(/10X, 'NAME OF THE FORM TO BE DELETED: '.#> 

808 FORM AT </10X. 'FORM '.10AI.' NOT FOUND IN DICTIONARY') 

809 FORMAT</10X,'FORM ',10AI,' HAS BEEN DELETED) 

810 FORMAT </10X. 'NAME OF THE FORM TO BE MODIFIED! '.*) 

811 FORMAT<^10X,'DO YOU WANT TO CHANGE FORM HEADER INFORMATION?', 

1 ' <Y/N)i ',♦) 

8 1 2 FORMAT < / 1 0X , ' CHANGE FORM NAME < Y/N ) ? ' , # ) 

813 FORMATv/ieX, 'NEW FORM NAMEi ',♦) 

814 FORMAT</10X, 'CHANGE ID NAMEvY^N)? ',♦) 

815 FORMAT(/10X, 'NEW ID NAMEi ',♦) 

816 FORMAT </10X,26HNEH ID'S STARTING COLUMNi ,$> 

817 FORMAT</10X,'THE FORMS IN THIS DICTIONARY AREi '//) 

818 FORMAT < //I 0X, DO YOU WANT SPECIFIC INFORMATION ON A FORM , 

1 '<Y/N>? '.$> 

819 FORHAT</10X, 'NAME OF THE FORM TO BE LISTED: ',!) 

820 FORMAT < / 1 0X , ' FORM NAME : ' , 1 8A 1 ) 

821 FORHAT(/10X,'IDi ',10A1,' ID STARTING COLUMN: ',14,' ID WIDTH: ', 

1 I4/10X, 'ID UALUE: ',10A1> 

822 FORMAT </10X, 'NUMBER OF ELEMENTS IN THIS FORM: '.14) 

823 FORMAT <//10X, 'DO YOU WANT AN ELEMENT LISTING F0:» THIS FORM<Y/N)?' 

1 IX, ») 

824 FORMAT</10X, 'THIS FORM CONTAINS NO ELEMENTS') 

825 FORMATC/10X, NAME OF THE ELEMENT TO BE LISTED: ',#) 

826 FORMAT C/10X, 'ELEMENT ',10A1,' NOT FOUND IN FORM ) 

827 FORMAT </10X, 'ELEMENT NAME; ',10A1) 

828 FORMAT </10X, 'ELEMENT STARTING COLUMN: ',14) 

829 FORMATS /10X, ELEMENT WIDTH: ',14) 

830 FORMAT </10X, 'ELEMENT TYPE: ',AD 

831 FORMAT<.'10X, 'FLOATING FOINT DECIMAL PLACES; ,12) 

832 FORMAT </10X, DESCRIPTION: ',40AD 

833 FORMAT </10X, 'THE DICTIONARY CONTAINS NO FORMS ON WHICH TO OPERATE' 

1 /10X, ... .YOU MUST ADD A FORM IN ORDER TO E.'nECUTE OTHER ', 

2 'OPERATIONS.') 

834 FORMAT </10X, 'FORM ',10A1,' CONTAINS THE FOLLOWING ELEMENTS: 

835 FORMAT<..'10X, ENTER ID WIDTH: ',$) 

836 FORMAT<:.'10X, 'CHANGE ID WIDTH ».Y,N)? ',4) 

837 FORMAT /1 0X, 'NEW ID WIDTH: ',$) 

838 FORMAT-:/ 10X, THERE ARE 50 FORMS CURRENTLY IN THE DICTIONAR'i' 

1 /10X, 'THIS IS THE MA.XIHUM NUMBER 'I'OU MAY NOT' 

2 /10X, 'PERFORM AN AC-D FORM OPERATION UNLESS YOU DELETE 

3 .10X, SOME OTHER EXISTING FORM. ) 

839 FORMAT<./10X, DO YOU WANT TO LIST AN ELEMENT Y/ N ) ? 
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84e FORM«T</10X. THE STARTING COLUMN OF THE ID MUST BE ^ 

1 ^BETHEEN 0 RND 5120O 

841 FORMRT</l0X,'HHRNINGi THE STORTING COLUMN ENTERED IS . 

I GREATER THAN 1310 

842 FORMAT </10X, 'THE ID WIDTH MUST BE BETWEEN 0 AND 10') 

84” FORMAT</10X/ 'WARNING) THE ID WIDTH IS GREATER THAN 131') 

844 FORMAT</10X, 'FORM '>10A1/' HAS ', 12 ,' ELEMENTS') 

845 FORMAT</10X, 'FORM '.10A1,' HAS BEEN DELETED FROM THE'. 

1 ' DICTIONARY') 

84G FORMAT</10X, 'FORM NAME GIUEN EXCEEDS 10 CHARACTERS' 

1 /10X.'FORH NAME ENTERED - '.10AD 

847 FORMAT</10X.'ID NAME GIUEN EXCEEDS 10 CHARACTERS 
1 /lOX. ID NAME ENTERED • '.10AD 

848 FORMAT </10X. 'NAME OF THE DICTIONARY (FILENAME . TYPE) » ' 

1 ,$) 

849 FORMAT </10X. 'AN IDWIDTH OF ',14.' STARTING IN COLUMN ',14 
1 ' EXCEEDS '/10X, 'THE MAXIMUM LENGTH OF 5120') 

850 FORMAT</'/10X, 'PROGRAM DICTIONARY SUCCESSFULLY TERMINATED ' 
1 /10X, 'THANK YOU FOR YOUR INPUT'V10X, 

2'HAUE A NICE DAY'//) 

f,51 FORMAT </10X, 'CHANGE ID STARTING COLUMN <Y/N)7 ',♦> 

852 FORMAT</10X, ENTER THE UALUE OF THE ID: ',<) 

853 F0RMAT</10X, 'ID UALUE GIUEN EXCEEDS ',14,', THE INDICATED 

1 /10X, 'MAXIMUM ID WIDTN' 

2 /10X, 'ID UALUE ENTERED ',10A1> 

854 FORMAT </10X, 'CHANGE ID UALUE <Y/N>? ',$> 

855 FORMAT </10X, 'ENTER NEW ID UALUE: ',♦) 

856 FORMAT</10X, 'INMALID FORM NAME.,. FORM ALREADY EXISTS ) 

857 FORMAT </10X, 'ENTER', 10X, FOR TYPE OF INSTRUCTIONS' 

1 //12X, 'S', 14X, 'SHORT INSTRUCTIONS 

2 /12X, 'L',14X, 'LONG INSTRUCTIONS' 

3 //10X, 'COMMAND: ',♦) 

858 FORMAT</10X, 'FORM FUNCTION: ',$) 

859 FORMAT</10X, 'TYPE , 10X, 'FOR REPORT TO BE SENT TO ' 

1 //12X,'T',14X, 'TERMINAL' 

2 /12X,'P',14X, 'LINE PRINTER' 

3 /12X, 'F',14X,'FILE' 

4 //10X, 'COMMAND: ',$> 

860 FORMAT </10X, 'REPORT DESTINATION) ',#) 

901 FORMAT (Al> 

903 FORMAT (1 0A1> 

904 FORMAT(10A1) 

905 FORMAT (I 2) 

906 FORMAT (14) 

907 FORMAT( I0AI , 10AI , 214, 10A1 , 214) 

90S FORMAT < 9 ( 50A 1 / ) , 50A 1 ) 

909 FORMAT ( 8X , 5 ( 2X , 1 0A 1 > ) 

910 FORMAT (9(50A1/),50A1> 

91 1 FORMAT( 10A1 , 14, 14, A1 , 12, 40A1 ) 

913 F0RMATa4) 

914 FORMAT(Q,10A1) 

915 FORMAT(Q..30A1) 

700 CALL COPYEdUP.IDOWN) 

WRITE(LPUNIT,850) 

CLOSE CUN I T=l) 

CL0SE(UNIT*2) 

I STOP* 1 
CALL EXIT 
END 

CUAX SUBROUTINE FINIS 
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CUAX COMMON/UNITS/ lUF / IDOHM. I STOP 

COAX IF< ISTOP.EQ . I )SETURN 

COAX LPUNIT-6 

CIJAX CALL COPYE<IUP.IDOHN> 

COAX ARITE<LPUNIT/899) 

CUAX 899 F0RMAT</18X, '♦♦♦♦*EHERGENCY SHUTDOWN***** v/ 

CUAX I I 0X , ' *****D I CT I ONARY REHR I TTEN***** ' > 

CUAX CLOSE<UHIT-l> 

CUAX CLOSE<UNIT-2> 

CUAX CALL EXIT 

CUAX RETURN 

CUAX END 

SUBROUTINE LCASEdPUT) 

C THIS ROUTINE RETURNS AH UPPER CASE LETTER FOR A 

C . LOWER CASE INPUT 

C 

LOGICAL*! A<26>/B<26>.IPUT 

DATA A/IHA. !HB. 1HC< IHD/ IHE. IHF. !HC. IHH/ IHI/ 1HJ> IHK/ 

1 IHL. IHH, IHN, IHO/ 1HP> IHR, IHS. IHT. IHU. IHU, IHW, IHX, IHY. IH2/ 
DATA B^lHi/ IHb^ !Hc. IHd/ IHi/ IHf . IHs/ IHh/ !Hi. IHJ/ !Hk. 

2 !H1 / IHm/ IHn. IHO/ 1 Hp< lHii/ !Hr/ IHs. IHt. IHu/ lH<v/. !Hh. !Hx/ IHw/ IHz/ 

C 

DO 10 1-1.26 
IF<B<I).NE. IPUT)GO TO 10 
IPUT-A<I) 

GO TO 20 
10 CONTINUE 
20 RETURN 
END 

SUBROUTINE COPYA<IUP. IDOWN) 

INTEGER*2 NFORHS. IDSTCL. IWIDTH.NUHELS.ESTCOL<100).EWIDTH<100). 

1 DPLACE<100>.DFLAG 

LOGICAL*! FNAHES<50. 10),FNAHE<10>. ID<10),ENAMES<100. 10>,ETVPE<100) 
1 .DESC< 100.40). IUALUE< 10) 

COHHON^ELEC/NFORHS. IDSTCL. IWIDTH. NUHELS. ESTCOL. EWIDTH. DPLACE. 

1 FNAHES . FNAHE .ID. ENAHE3 . ET YPE . DESC , DFLAG . I END . I UALUE 
C 
C 
C 
C 
C 

REWIND lUP 
REWIND IDOWN 
IF<NFORHS.EQ.0)GO TO 20 
DO 10 I-l.ll 
10 READ<IUP.901) 

20 WR I TE < I DOWN . 905 ) NFORMS+ 1 

WRITE< IDOWN. 910) < <FNAHES< I . J) . >1 . 10) . 1=1 . 50) 

IFCNFORHS . EQ . 0)RETURN 
DO 100 I-l.NFORHS 

READ< lUP. 907) <FNAHE< J) . J=1 . 10) . < ID< J) . J=1 . 10) . IDSTCL. IWIDTH. 

1 < I UALUE < J > . J= 1 . 1 0 ) . NUHELS . I END 

HRITE< IDOWN. 907)<FNAHE<J).J=1. 10) . <ID<;J).J=1. 10). IDSTCL. IWIDTH. 

1 <IUALUE<J).J=1. 10). NUHELS. lEND 

IF<NUHELS.EQ.0)GO TO lOO 
DO 50 J-1. NUHELS 

READ<lUP.911XENAHE3';j.K).K=l. 10).ESTCOL(J).EWIDTH(J).ETVPE<J) 

1 .DPLACE<J).<DESC<J.K).K=1.40) 

WRITE< IDOWN. 91 lXENAHES<J.K).k=l. 10). ESTCOLU). EWIDTH*. J).ETYFE<J) 
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I ,DPLrtCE<J).<DE3C<J-K),K-l,40) 

50 CONTINUE 
lee CONTINUE 
RETURN 

901 FORHNTUX) 

905 F0RMNTa2) 

907 F0RHAT<10A1>10N1> 214. 1001 >214) 

910 FORMOT<9<50Ol/).50fil> 

911 FORHOTaONl. 14. 14.01. 12.4001) 

END 

SUBROUTINE COPYDaUF. IDOHN.NDEL) 

INTEGER*2 NFORMS. IDSTCL. IHIDTH.NUMELS.ESTCOL<100).EHIDTH<IO0). 

1 DPLOCEaOO).DFLOC 

LOGICOL*! FNOMES<50. 10) . FN0ME< lO) . ID< lO) .EN0MES< lOO. 10) .ETVPE< IO0) 
1 .DESC< 100.40). IU0LUE< 10) 

CCHMON/ELEC/NFORHS . I DSTCL . I H IDTH. NUHELS . ESTCOL . EW I DTH . DPLOCE . 

1 FNOMES . FNOHE .ID. ENOMES . ETYPE . DESC . DFLOG . I END . I UOLUE 


REHIND lUP 
REWIND I DOWN 
DO 10 J-1.11 
10 REODCIUP.SOl) 

HR I TE < I DOWN . 90S ) NFORMS 

HRITE<IDOWN.910X<FNOHES<I.J).J«1. 10).I-l.5O) 

IF<NFORHS.EQ.0)RETURN 

N-NFORHS+1 

DO 100 I-l.N 

REOD<IUP.907)<FNOME<J).>1.10).<ID<J). J»1.10). IDSTCL. IWIDTH. 

1 <IU0LUE<J).J-1. 10). NUHELS. lEND 
IF<I,NE.NDEL) 

1 HRITE<IDOWN.907)<FNOME<J).J-1. 10). <ID<J).J»1. 10). IDSTCL. IWIDTH. 

2 <IU0LUE<J).J-1. 10). NUHELS. lEND 
IF(NUMELS.EQ.0) GO TO 100 

DO 50 J-1. NUHELS 

REOD<IUP.911)<ENOMES<J.K).K»1.10).ESTCOL<J).EWIDTH(J).ETYPE<J) 

1 .DPL0CE<J).<DESC<J.K).K«1.40) 

IF<I.NE.NDEL) 

1 WRITE<ID0WN.911)(EN0HES<:J.K).K*1. 10).ESTCOLU).EWTDTH<J).ETYPFaJ> 

2 .DPL0CE<J).<DESC<J.K).K»1.40) 

50 CONTINUE 

100 CONTINUE 
RETURN 

901 FORHOTUX) 

905 FQRM0T<I2> 

907 FORMOTdOOl. 1001.214. 1001.214) 

910 FORMOT<9<50O1/).50O1) 

911 FORMOT<10O1. 14. 14.01.12.4001) 

END 

SUBROUT I NE COPYM < I UP . I DOWN . I FLOG . MEND ) 

INTEGER+2 NFORMS. IDSTCL. IWIDTH. NUHELS. ESTCOLa00).EWIDTHa00>. 

1 DPLOCE < 1 00 ) . TCOL . TW I DTH . TEL3 . TECOL 1 OO ) . TEW < 1 00 ) . TPLOCE ( 1 00 ) 

2 .TEND. DFLOG 

LOGICAL*! FNOMES(50. 10).FNOHE<10). IDLIO/.ENOMES'.IOO. 1 0. ■. ETYPE (lOO) 
1 ,DESC<100.40).TNOMEa0).TID<l0^.TENOM< J00. 10> . TTYFEaOO) . 

1 TC€SC<100.40). IOOLUE<10).TUOL<10) 

COMMON/'ELEC.'NFORMS. IDSTCL. IWIDTH. NUHELS. ESTCOL. EWIDTH. DPLOCE. 
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1 FNAHES > FHAHE /ID/ EHAHES / ETVPE / DE3C / DFLAC / 1 EHD / 1 UOLUE 
COMMON^REUSE/TDESC/ TECOL/ TEHAH/ TEH/ TID/ TNflHE/ TFLACE/ 

I TTYPE/TVAL 


REMIND lUP 

REMIND IDOMN 

HR I TE< I DOHN / 905 > NFORHS 

HRITE< IDOMN/ 9I0X <FNAHE3<I / J> . >1 / 10) / 1>1 / 50> 

DO 10 J-1/11 
10 READ<1UP/901> 

DO 100 I«l/ NFORHS 

READ< IUP/907XTNAHE< J) / J-1 / 10) / aiD< J) , J-i / 10) / TOOL/ TMIDTH/ 

1 <TUAL<J)/>1/10)/TELS. TEND 
IFU.NE.IFLAG) 

1 HRITE<IDOHN/907)<TNAME<J)/J-1/10)/<TID<J); J-1/10)/TCOL/THIDTH/ 

2 <TyAL<J)/J-l/10)/TELS/TEND 
IFa.EQ.IFLAG) 

1 HRITE<IDOHN/907XFNAHE<J)/>1/10)/ <ID(J)/J»1/10)/IDSTCL/IHIDTH/ 

2 <IUALUE<J)/J-1/10)/NUHELS/HEND 
IF<TELS.EQ.O)GO TO 55 

DO 50 J-l/TELS 

READ< lUP/ 911 XTENAH< J/ K) /K-l / lO) / TECOLU) / TEMU) / TTYPE< J) 

1 /TPLACE<J).(TDESC<J/K)/K«l/40) 

IFU.NE.IFLAG) 

1 HRITE< IDOMN/ 91 1 XTEHAM*. J/K> / K-1 / 10) / TECOL*. J) / TEMU) / TTYFE*' J) 

2 /TPLACE<J)/<TDESC<J/K)/K-l/40) 

50 CONTINUE 

55 IFU.NE. IFLAOGO TO 100 
IF<NUMELS.EQ.0)GO TO 106 
DO 60 J-l/NUHELS 

60 WRITE*: IDOMN/ 91 1 ) <ENAHESU/ K) / K»l , 10) / ESTCOL< J) / EMiDTH < , 

1 ETYPE<J)/DPLACE<J)/ *.DESC<J/K;'/K»l/40) 

100 CONTINUE 
RETURN 

901 FORMAT < IX) 

905 FORMAT*; 12) 

907 FORMATaOAl/10Al/2I4/ 10A1/2I4) 

910 FORMAT*'9<50A1.O/50A1) 

911 FORHATU0A1/14/I4/A1/I2/4OA1) 

END 

SUBROUTINE COPVEv lUP/ IDOMN) 

INTEGER*2 NFORMS/ IDSTCL/ IMIDTH/NUMELS/E3TCOlLUO0)/EHIDThU00), 

1 DPLACE <100)/ DFLAG 

LOGICAL*! FNAHES(56/ 10)/FNAME<10)/ IDa0)/ENAHESUO6/ 10),ETVPEvlO0) 
1 /DE3C< 100/40) /IUALUE< 10) 

COMMON/ELEC/NFORMS/ IDSTCL/ IHIDTH/ NUHELS/ ESTCOL/ EMIDTH/ DPLACE/ 

1 FNAMES/ FNAHE/ ID / ENAHES, ETVPE / DESC/ DFLAG/ I END, lUALUE 


IFUUP.EQ. DRETURN 
REMIND I UP 
REMIND IDOMN 
DO 10 1=1/11 
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10 REAC*<1UP.901> 

HR1TE< IDONN. 905>Nf0RHS 

HRI TE< IDOHN. 910X ^FN#M^ES< I . J) , >1 . ' . I-l / 50> 

00 100 1>1.NF0RHS 

READ<lUF.907HFhllHEU><>l. 10 >mID<J>> > 1. 10>/ lOSTCL/ IHIDTH. 

1 <IUflLUE(J^>l/10>/NUHELS>IEND 

HRITE<IDOHN,907^<FN«ME<J),J«1, 10>, <ID<J), >1. 10), lOSTCL/ IHIDTH, 

1 aURLUE<J>,>l/10),NUHEL8/I{:.'r 
1F<NUHELS.EQ.0)G0 TO 100 
DO 90 J-l/NUHELS 

REOD< lUP, 91 1 )(ENOHES( J/K) ,K*1 , 10) .ESTCOU J> , ENIDTH< J) , ETVFE<. J> 

1 ,0PL0CE<J>,<DESC<J,K),K«l/40> 

HRITE<ID0HN,911KENAHES<J,K),K-l,10>,ESTC0L<J>,EHIDTHU>,ETVPEiJ) 

1 ,DPL0CE<J>,<DESC<J,K),K-1,40> 

90 CONTINUE 
100 CONTINUE 
ENDFILE lUP 
ENDFILE IDOHN 
RETURN 

901 FORMfiTUX) 

909 F0RM«T<I2) 

907 F0RHRT<10R1,10R1,214,10R1>7I4) 

910 FORM«T<9<90«1/),90P1) 

911 FORHRT<10R1,I4, I4,A1,I2,40R1) 

Ei'iD 

SUBROUTINE FETCH<IUP, IFLflG) 

INTECER*2 NFORMS, lOSTCL, IHIOTH,NUMELS,ESTCOL<lO0v,EHIDTHaOO>, 

1 0PLRCE<100),DFLAC 

LOCICRL^l FNfiHEE^30> 10> , FN«HE< 10) , ID< lO^ , £NfiHES< 100, 10) , ETYFE^ 100) 
1 ,OE3Ca»)0 40),IURLUE<10) 

COMHON/'ELEC/'NFORHS, IDSTCL, IHIDTH,NUMELS/ESTCOL,EHIOTH,&PLhCE, 

1 FN«MES,FNfiME, ID,EN«HES,ETYPE,OESC.DFLflO, lEND, lUfiLUE 


REMIND lUP 
DC 9 1-1/ 10 
9 IU«LUE<I)-' " 

DO 10 1-1/ 11 
10 REMD<IUP/901> 

IFaFLMC.EQ.DCO TO 200 
K-IFLMG-1 
DO 100 1-1 /K 
REflD<IUP/912)NUHELS 
IF<NUMELS.EQ.O)GO TO 100 
DO 50 J-l/NUHELS 
50 REfiD<IUP/901) 

100 CONTINUE 

200 REfiraUP/902)<FN«HE<J)/J»l/10)/vID<J)/J-l/10)/IDSTCL/IMIDTH/ 

1 < I U ALUE ( J ) / J- 1 / 1 0 ) / HUHEL3 / I END 
IF<NUHELS.EQ.O)GO TO 300 
DO 20 J-l/NUMELS 

20 READ<IUP/903)<ENflHESU/K),k«l/10)/ESTCOL<J)/EHIDTHU>/ETYFEU)/ 
1 DPLfiCE<J)/ <DESC<J/K)/K=l/40> 

300 RETURN 

901 FORMAT (IX) 

902 FORHATUOAl / lOAl / 214, 10A1 / 214) 

903 FORHATUOAl / 14/ 14/ Al / 12/ 40A1 ) 


100 


O O O O OO O o o OOOOOOOO 


912 F0RHAT(38X. 14> 

END 

SUBROUTINE UALNAH<CFNBHE«FNAHES/NFORHS/NEH/LPUHIT> 


THIS ROUTINE DETERMINES IF THERE IS RN EXISTINC 
FORM IH THE DICTIONARY OF THE SAME NAME. IF THERE IS 
UARIABLE HEH IS SET TO 0/ IF NOT HEH IS SET TO 1 . 


LOGICAL*! CFHAHE<10><FNA^€S<9e.ie> 

»CH-1 

DO lee 1-1«NF0RH8 
DO 150 >1^10 

IF<CFNAHE<J>.NE.FNAHES<I«J>>GO TO 100 
150 IF<J.EQ.10>NCH*O 
IF<NEH.EQ.0>RETURN 
100 CONTINUE 
RETURN 
END 

SUBROUTINE OUERLPUD. IDSTCL. IHIDTH.ENANES.ESTCOL. 

1 EHIDTH/NUHELS) 

THIS ROUTINE CHECKS FOR OUERLAPPING ELEh€NTS HITHIN THE FORM 

LOGICAL*! FNANE< 10> ; ENA)-€S( 100« 10> / ID< 10> 

1NTEGER*2 IDSTCL/ IHIDTH.ESTCOL<100><EHIDTHaO0>/NUHELS 


IF<NUNELS.EQ.0>RETURN 
IFO Ul/NUHELS 
IF<ID<1>.EQ.' OGO TO 150 

IF< < IDSTCL*IHIDTH) . LE . ESTCOL< I > .OR . IDSTCL . GE . <ESTCOL< I >*EHIDTH< I > > 
1 >G0 TO 150 

HRITE<LPUHIT/e01><ID<K><K«l>10>/<ENAHES<I>K>/K»1.10> 

150 DO 200 >1«NUHELS 
tF<I.GE.J>GO TO 200 

IF < <ESTCOL< I >-»EHIDTH< I > > . LE . ESTCOL< J> . OR . ESTCOL< I > . CE . 

1 <ESTCOL<J)*EHIDTH<J>>)GO TO 200 

HRITE<LPUNIT/ 802)<ENAMES< I /K> / K»1 / 10) . <ENAMES< J> K> , K«1 / 10> 

200 CONTINUE 
100 CONTINUE 


801 FOSNAT</'10X> 'WARNING I ID ELEMENT MOAl/ ' OUERLAPS ONTO ' 

1 ' ELEMENT MOAl) 

e02 FORilWTC/lOX. 'WARNING i ELEMENT ',10A1,' OUERLAPS WITH ' 

1 ELEMENT '.lOAD 
RETURN 

L.^D 

SUBROUTINE REP0RT(FILE,NDICT.RDE3T/ lUP.LPUNIT) 

C 

C 

INTEGER*2 ESTCOL< lOO) / EWIDTH< lOO) . DPLACE< lOO) ,DFLAG 
LOGICAL+l FILF<30)>FNAMES<5O,l0).FHAHE<l0).IDaO).IUALUE<10). 

1 ENAMES< 100.10). £TYPE< 100) . DESC< 100. 40) . DFMT <60> . RDEST 

2 .FILE2(40) 
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COMHOH^ ELEC/NFORMS, IDSTCL. IHIDTH,MUHELS»ESTCOL.EWIMH ^ L^iCE. 
1 FHh»€S.FNAHE, lD.£HA»lEc-.ETVPE>DE$C,DFLAC/ lEt^lD. lUALUE 
C 

C THIS ROUTINE GEhCRHTES REPORTS ON THE DICTIONARY 

C 

LINES-e 

C 

C REPORT DESTINATION 

C 

IF<RDEST.NE.'T')GO TO 20 
lUNIT-LPUNIT 
CO TO 60 
20 CONTINUE 

CLSI IF<ROEST.EQ. 'P')CO TO 30 

NRITE<LPUNIT,806> 

READ«.;S.906>NC/<FILE2<I>> I*LNC> 

FILE2<NC+l>-0 

IUNIT-3 

IF<RDEST.EQ.'F'; 

1 0PEN<UNIT-3/NAME-FILE2, TYPE- NEW , ACCESS- 'SEQUENTIAL ' , 

2 FORM- ' FORMATTED ' , D I 3P0SE- KEEP ' , CARR I AoECONTROL- FORTRAN ' ) 
IF<RDEST . EQ . ' F ' >HR I TE<LF UNI T , 307 H F ILE2 V I > / 1 - 1 , NO 

CUAX IF<.RDEST.EQ.'P") 

CUAX I OPEN<UNIT-3,NA^€»FILE2.TYPE-'NEH , ACCESS- SEQUENTIAL > 

CUAX 2 FORM-'FORMATTED', DISPOSE- PR INT^DELETE/ 

CUAX 3 CARR IACECONTROL-' FORTRAN > 

CUAX IF<RDEST.EQ. P'>HRITEvLPUNIT,S0SKFILE2<i:<. I-l.NC,' 

CLSI 30 IF^RDEST.EQ.'P')IUNIT-6 

CLSI IF<RDEST.EQ.''P'>WRITE<LPUNIT,808> 

C 

C PRINT THE NAMES OF THE FORMS IN THE DICTIONARY 

C 

60 ENCODE<47.80I.DFHT>NDICT 

WRITE<IUNIT*DFMT)<FILE<I>>I«l/NDICT> 

LINES-LINES-^1 
K-NFORMS/5+l 
DO 100 I-l/K 
KB- I *5 
KA-KB-4 

KB-MIN0<KB,HFORMS) 

HRITE<IUNIT.903)<<FNAHES<ILJ>,J-l,l0>.II-KA,KB^ 

LINES-LINES-t-l 
160 CONTINUE 

IF<RDEST.EQ. 'F' .OR.RDEST.EQ. 'POHRITEvIUNIT. 907> 

C 

C PRINT INFO ON EACH FORM 

C 

DO 200 I*1,NF0RMS 
IPNT-I 

CALL FETCH<1UP, IPNT> 

HRITEaUNIT,802^<FNAME<J)/J»l, 10)/NUHELS, lEND, <ID<J>, J-1, lO), 
1 IDSTCL> IHIDTH,<IUALUE<J),J-l,10) 

HRITE<IUNIT.805> 

LINES-LINES+7 

I F ( L INES . GE . 2 1 CALL HC.NG< L INES/ 1 UN I T , LPUN 1 1 > 

IFaiUHEL3.NE.0>GO TO COO 
HRITE<IUNIT,803> 

CALL HANG<LINE3, IUNIT,LPUNIT> 

GO TO 200 

360 DO 500 J-l.NUMELS 
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DO 310 K-40.1 -1 
IHD-K 

1F<DESC<J/K).NE. ' OGO TO 315 
310 CONTINUE 

315 MRITE<IUNIT;804><EN«MES<J/K>.k»l,10>,ESTCOL<J)/EHIDTH<J),ETYP£<J>. 
1 DPLfiCE<J),<DESC<J,K),k-l,IND) 

LINES-LINES-M 

IFCLINES , GE . 21 )CALL HfiHG<LINES, IUNJT,LPUNIT> 
IF<LINES.EQ.0>NRITE<IUHIT.903> 

IF<LINES.EQ.0.AND.RDEST.EQ.'T^AND.J.NE.NUHEL&>HRlTEaUNIT.S05> 

IF < L I NES . EQ . 0 . AND . RDE3T . EQ . ' T ^ »ND . J . HE . NUHELS >L I NE3«L I NEo<*-6 
500 CONTINUE 

IF<I .NE.NFORHS)CfiLL HfiNGCLINES, IUNIT,LPUNIT) 
IF<RDEST.EQ.T".OR.RDEST.EQ.P'>WRITE<IUNIT,907) 

200 CONTINUE 

CLSI IF<RDEST.EQ.'POHRITE<6>909) 

CLSI IF<IUNIT.EQ.3)CL0SE<UNIT-3> 

RETURN 

C 

C 

C 

801 F0RNfiT('(/lX.24HTHE FORMS IN DICTIONfiRY 

1 ■^■fil>5H AREi/)0 

802 FORMAT <// IX. 'FORMNfiHE! M0R1.5X. 'NUMBER OF ELEMENTS! M4. 

1 5X. 'RECORD LENGTH! '.I4//1X,'ID NPMEi '.10fil,2X, 

2 'ID STORTING COLUMN' '.I4.2X.'ID WIDTH! '.I4.2X. 

3 'ID UOLUEi '.1001/) 

803 FORMOT</10X. 'NO ELEMENTS IN THIS FORM //) 

804 FORMOT< IX. 1001 . 2X. 14. 3X. 14. 3X. 01 . 4X. 12. 5X. 4001 ) 

805 -^ORMOT^IX. 'ELEMENT', 3X. STORTING' . IX. 'FIELD'. 

1 IX. 'TYPE'. IX. 'DECIHOL'. IX. 'DESCRIPTION'/IX. 'N0ME'.6X. 

2 ' column '. 3X .' W I DTH '. 6X . ' PLOCES ' / ) 

CLSI 806 FORMOT</10X. 'FILENOME FOR FILED REPORT ' 

CLSI 1 /10X. '<FILENOHE.TYPE) * •.♦) 

CUOX 806 FORMOT</10X. 'FILENAME FOR PRINTED OR FILED REPORT' 

CUOX 1 /10X. ''sFILENOME.TYPE) * '.♦) 

807 FORMAT </10X. 'REPORT HAS BEEN FILED UNDER' 

1 /10X. '(FILENAME. TYPE) = '.4001) 

CLSI 808 FORMAT </10X. 'REPORT HAS BEEN SENT TO THE LSI LINE PRINTER ) 
COAX 808 FORMAT(/10X. 'REPORT HAS BEEN SENT TO THE LINE PRINTER' 

CUAX 1 /10X. '(FILENAME. TYPE) = '.40A1.» 

901 F0RHAT(I2) 

902 FORMAT(9(50A1/).50A1) 

903 FORMAT(5(2X.10A1)) 

904 FORMAT(10A1. 1001,214, 1001,214) 

905 FORMAT( 1001,214.01, 12. 4001) 

906 FORMAT (Q. 4001) 

CUAX 907 FORMAT aHl) 

CLSI 907 FORMAT (//) 

90S FORMAT ax ) 

CLSI 909 F0RMAT(5(131(1H )/)) 

END 

SUBROUTINE HANG(LINES, lUNIT.LPUNIT) 

C 

C STOPS OUTPUT WHEN SCREEN IS FULL 

C 

I F ( I UN I T . NE . LPUN I T > RETURN 
WRITE(LPUNIT,801) 

READ(5.901) 

LINES=0 
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RETURN 


801 F0RHNT</1X> 'TYPE RETURN TO CONTINUE i 
901 FORMOT<1X> 

END 

SUBROUTINE ELEHNTUNST.LPUNIT) 


THIS ROUTINE HILL SELECT THE THE ADD. DELETE. MODIFY. 

OR LIST COMMANDS AT THE ELEMENT LEUEL. 

ALL INFORMATION OTHER THAN THE DICTIONARY HEADER MUST BE 
REHRITTEN TO DEUICE THO PRIOR TO EXIT FROM ELEMNl . 


INTECER>«‘2 NFORHS. IDSTCL. IHIDTH.NUHELS.ESTCOL<100>.ENIDTHaOO>. 

1 DPLACE< 100) .DFLAG. ITCOL< 100) . IH< 100) . IP< 100) . C. H 
L0G1CAL«1 FNAHES(50. 10).FNAfiE<10) . 1D< 10) . ENAME3< 100. 10).ETYPE<. 100> 

1 . DESC< 100.40) . YORN. ECOH. CENAME <10) . 

2 T.IUALUE<10).INST 

COMHON/ELEC/NFORMS. IDSTCL. IHIDTH.NUMELS.ESTCOL.EHIDTH.DPLACE. 

1 FNAMES.FNAME. ID.ENAMES.ETYPE.DFoC.DFLAO. lEND. lUALUE 


ACCEPT ELEMENT COMMANT- 


50 IF<INST.EQ. L ^WRITEaPUNIT.SOl) 

IF< INST. EQ.'S)HRITE<LPUNIT. 843) 
NCLEAR«NUMELS’»>1 
DO 60 I-l.lO 
60 ENA^^ES<NCLEAR.I)-' 

ESTC0L<NCLEAR)-0 
EHIDTH<NCLEAR)-0 
ETYPE<NCLEAR)«' ' 

DPLACE<NCLEAR)-0 

READ< 5 . 901 . END-50. ERR>50)EC0M 

CALL LCASE<ECOH) 

IF<ECOM.NE.'A')GO TO 200 

ADD ELEMENT COMMAND 

IF<NUHELS.EQ.100)GO TO 450 
70 HRITE<LPUNIT.802) 

READ<5. 902.END-70.ERR-rO)N, <CENAME< I >. I«1 . 10) 

IF<CENAME<1).EQ.'- ')G0 TO 70 

IF<N. GT . 10) WRITE<LPUNIT. 842) (CENAME < I ) . 1*1 . lO.- 

CALL ELEUALvCENAHE.ENAMES.NUHELS. NEMEL) 

IF<NEHEL.EQ.1)G0 TO 80 

HRITE<LPUNIT.846) 

GO TO 70 

80 NUMELS-NUMELS+1 
DO 100 K«1.10 

1 00 ENAMES ( NUMELS . K ) -CENAME < K ) 

101 HRITE<LPUNIT.803) 

READ ( 5 . ♦ . END* 1 0 1 . ERR- J 0 1 ) ESTCOL NUMELS ) 
C-ESTCOU.NUhELS) 

IF<C.LT.0.OR.C.CT.5120)NRITE<.LPUNIT.836> 
1F<C.LT.0.OR.C.CT.512O)GO TO 101 
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IFvC.GT.13l)HRITE<LPUNIT,837) 

102 HRITE<LPUHlT/604> 

REM>< 9 . * . EtiO- 102 . ERR* 102 >EHIDTH<NUMELS> 

H-EHIDTH<NUHcLS> 

IF<H.LT.0.0R.H.GT.5120>HR1TE<LPUNIT.S33> 
1F<H.LT.0.0R.H.GT.5120>G0 TO 102 
IF<H.GT.131>HRTTE<LPUN1T>839) 

IF<<C+H-1).LE.5120)GO TO 109 
HRITE<LPUNlT>e44)H/C 
GO TO 102 

109 IFdNST.EQ. 'L''>HRITE<LPUNIT.809> 

IF< INST. EQ.^SOMRITE<LPUNlT, 849) 
READ<9/901.END«109.ERR-109)ETYPE<NUHELS) 

CALL LCASE<ETYPG<NUHELS)> 

T-ETYPE<NUMELS) 

IF<<T.EQ.^flO.OR.<T.EQ. 'r>.0R.(T.EQ. 'X').0R. 

1 <T.EQ.'F^))G0 TO 108 

GO TO 109 

108 IF<ETYPE<NUMELS).NE. T')G0 TO 110 
107 HRITE<LPUNlTi808> 

RE«0<9/ 904, END-107. ERR-l07)DPLflCE<NUMELS) 
IF<DPLRCE<NUHELS) . LT . 0 , OR . DPLRCEvNUHELS) . GT . 9> 

1 HRITE<LPUNIT,841) 

IF<DPL«CE<NUHELS>.LT.0.OR.Dr<.ACE<NUMELS>.GT.5)GO TO 10? 
1F<DFLACE<NUMELS).LE.W>C0 TO llO 
NRITE<LPUNIT,849>N 
GO TO 107 

110 IF<.N0T.<T.EQ.^I'.flND.H.GT.9))G0 TO 111 
HRITEaPUNIT,847) 

GO TO 102 

111 N*H-DPLI^CE<NUMELS> 

IF<.NOT.<T.EQ. FM:)ND.H.GT.10>)GO TO 112 
WRITE<LPUNIT,8S3) 

GO TO 102 

112 HRITE<LPUNIT,807) 

READ<9, 901 , END-1 10, ERR-1 10)YORN 
CALL LCnSE<YORN> 

DO 119 1-1,40 

113 DESC<NUMELS,I)--' ' 

IF<YORN.EQ. "N')G0 TO 50 
IF<YORN.NE. YOGO TO 110 

120 NRITE<LPUNIT,808> 

RERD < 5 , 905 , END- 1 20 , ERR - 1 20 ) N , < DE8C < NUHELS , K > , K- 1 , 40 > 
IF<DESC<HUHELS,1).EQ.^ )G0 TO 120 
IF<N.GT.40>I«IRITE<LPUNIT,843><DESC<NUHELS,K),K-1,4O> 

GO TO 50 

200 IF<ECOM.NE. 'DOGO TO 241 

DELETE ELEMENT COMMAND 
IFLAG-0 

205 HRITEClPUNIT,810> 

READ < 9 , 908 , END-205 , ERR-205 ) < CENAME < I ) , I - 1 , 1 0 > 
IF<CENAME<l>.EO.' ')G0 TO 205 
DO 210 1-1,NUMELS 
DO 215 J-1,10 

IF<CENAME<J).NE.ENAMESa,J))GO TO 210 
215 IF<J.EQ.10)IFLAG-I 
210 CONTINUE 

IF<IFLAC.NE.0)GO TO 220 
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HRITE<LPUNIT/811><CENA^€U>»l•l/10> 
CO TO 5d 


DELETE ELEhtENT NAME 

220 DO 230 I-IFLAG/NUHELS 
DO 235 >1.10 

235 ENAHES<I/J>-ENAHES<I-»-i.J> 

DELETE OTHER ELEMENT FIELDS 

ESTC0L<I>-ESTC0L<I^1> 

EH1DTH<I>-EHIDTH<I4-1> 

ETVPE<I>-ETYPE<I+1> 

DPLACE<1>-DPLRCE<I-^1) 

DO 236 >1.40 

236 DESC<I.J)-DESC<I-*>1.J> 

230 CONTINUE 

NUMELS-NUMELS-1 

NRITE<LPUNIT.840XCENAHE<I>. I«l. 10> 

GO TO 50 

241 IF<ECOM.NE. "MOGO TO 30O 

MODIFY ELEMENT COMH«ND 

242 HRITE<LPUNIT.812) 

REMD <5.906. EhK)-242 . ERR-242 )< CENMHE < I > . I - 1 . 1 0 > 

IF<CEN«ME<1).EQ." OGO TO 242 

IFL<:iG-0 

DO 240 I»1.NUHEL3 
DO 245 >1.10 

IF<CENAHE<J>.NE.ENRHES<I.J)>GO TO 240 
245 IF<J.EQ.ie>IFLRG«I 
240 CONTINUE 

IF<IFL«C.NE.O)GO TO 250 
HRITE<LPUNIT. 81 1 ><CENRHE< I ) . I*i . 10> 

GO TO 50 


MAKE MODIFICATIONS ON ELEMENT FIELDS 

250 HRITE<LPUNIT.813) 

READ<5. 901 . END-250. ERR-250>Y0RN 
CALL LCASE<YORN> 

IF<YORN.EQ.^N') CO TO 260 
IF<YORN.NE.'YOGO TO 250 
255 WRITE<LPUNIT.814) 

READ<5. 902. END-255. ERR«255>N. <CE.NAHE< J) . >1 . 10> 
IF<CENAME<1).EQ.' )G0 TO 255 
IF<N.GT.10)HRITE<LPUNIT.S42><CENAME<J>.>1.10> 
CALL ELEUAL < CENAHE . ENAHE3 . NUMELS . NEHEL > 
IF<NEMEL.EQ.1>G0 TO 258 
HRITE<LPUNIT.846) 

GO TO 255 

258 DO 259 1-1.10 

259 ENAHESC IFLAG. I >«CENAME< I > 

260 HRITE<LPUNIT.815) 

READ<5. 901. END-260. ERR>260>V0RN 
CALL LCASE<YORN> 

IF<YORN.EQ. 'N^^GO TO 270 
IF<YORN.NE. Y')GO TO 260 
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265 HRITE<LPUN1T.616> 

RE1«<S/ «« END-265/ ERR-265> ESTCOL< IFLAG> 

C-ESTCOL<IFU»> 

IF<C.LT.0.OR.C.GT.512e>HRlTE<LPUNIT.83e> 
IF<C.LT.e.OR.C.GT.5120>GO TO 265 
IF<C.GT . 131 >HRITE<LPUNlT/837> 

270 WRITE<LPUNIT,ei7> 

RERD< 5/ 901 . END-270. ERR-2‘*0> YORN 
CALL LCRSE(YORN> 

1F<Y0RN.EQ.^N^>G0 TO 280 
IF<YORN.NE.'YOGO TO 270 
275 HRITE<LPUNIT.818> 

READ<5.>«. END-275. ERR-275> ENIDTH<IFLAG> 

H-EHIDTH<IFLAG> 

IF<H.LT.0.OR.H.GT.5120>NRITE<LPUNIT.836> 
IF<H.LT.0.OR.H.GT.512O>GO TO 275 
IF<H . GT . 131 >HRITE(LPUNIT. 839) 

280 NRITE<LPUNIT.819> 

READ<5.901 .END-280. ERR-280>YORN 
CALL LCASE(YORN> 

IF<VORN.EQ.'N^AND.ETYPE<IFLAG).EQ."FOGO TO 285 
IF<YORN.EQ.'N')GO TO 290 
IF(YORN.NE.'Y')GO TO 280 

281 IF< INST . EQ . 'L" >HRITE(LPUNIT.820> 
IF<INST.EQ.'S')HRITE<LPUNIT.850> 

IF<ETVPE<IFLAG) .EQ. 'FODPLACE<IFLAG>--0 
READ<5. 901 . END-281 . ERR-281 > ETYPE< IFLAC) 

CALL LCASE<ETYPE<IFLAG>> 

T-ETYPE< IFLAG) 

IF<<T.EQ.'A').OR.<T.EQ. 'I').OR.(T.EQ,''X'>.OR. 

1 <T.EQ.TO)GO TO 285 
GO TO 281 

285 IF<ETYPE< IFLAG). NE.'F) GO TO 298 
IF<DPLACfe< IFLAG). EQ.0)GO TO 286 

284 HRITE<LPUNIT.851) 

READ<5.901)YORN 
CALL LCASE<YORN) 

IF<YORN.EQ.'N')GO TO 290 
IF<YORN.NE. 'Y')GO TO 284 

286 HRITE<LPUNIT.821) 

READ < 5 . 904 . END-286 . ERR-286 ) DPL ACE < I FwAG > 

I F < DPLACE < I FLAG ) . LT . 0 . OR . OPLACE < I FL AG ) . GT . 5 > r^R I TE < LPUN I T . S4 1 ) 
lF<DPLACE<IFLAG).LT.0.OR.DPLACc<IFLAG.*.GT.5)GO TO 286 
IF(DPLACE< IFLAG). LE.EWIDTH<IFLAG))GO TO 290 
WRITE<LPUKIT.845)EHIDTH<IFLAG) 

GO TO 286 

290 I F < ET YPE < I FLAG ) . EQ . I" . AND . EH I DTH < I FL AG > . GT . 9 > WR I TE < LP UN I T . 84 7 
W-EHIDTH< I FLAG) -DPLACE < IFLAG) 

IF < ETYPE < I FLAG ) . EQ . ' F " . AND . W . GT . 1 0 ) HR I TE < LPUN I T . 853 > 
WRITE<LPUNIT.822) 

READ<5. 901 . END-290. ERR-298) YORN 
CALL LCASEvYORN) 

IF<YORN.EQ."N')GO TO 50 
IF<YORN.NE.'Y')GO TO 290 
295 WRITE<LPUNIT.823) 

READ<5. 905. END-295. ERR*295)N. <DESC< IFLAG. J) . J-i . 40> 

IF<DESC<IFLAG. D.EQ. ' )GO TO 295 

IF<N . GT .40) WRITE <LPUNIT. 843) (DESC< IFLAG. J) . J-1 . 40) 

GO TO 50 

300 IF<ECOH.NE. L) GO TO 400 
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LIST ELEMENT COHHAHD 

IF<HUHELS.NE.d>GO TO 305 
HR1TE<LFUN1T.835><FNAH£< 1 > « I«1 . 10> 

GO TO 50 

305 HRITE<LPUHIT/e24><FNAHE<I>/J>M0> 

N-NUHELS 

M«5 

K-N/M+1 
DO 310 I-l/K 

KA-KB-4 

KB-HINO<KB/NUHELS> 

HRITE<LFUNIT/9e7><<ENflHES<II.J>/>l/10>.II-KA/KB> 
310 CONTINUE 

315 NRITE<LPUNlT.e25> 

READ<5> 901/ END-315/ ERR-315>Y0RN 
CRLL LCRSE<Y0RN> 

IF<Y0RN.EQ.'NO GO TO 50 
IF<Y0RN.NE.'YOG0 TO 315 

SEARCH FOR AND LIST AN ELEMENT 

316 NRITE<LPUNlT/826> 

READ<5/ 906/ END-316/ ERR-316><CEHA^4E< I >/ 1«1 / 10> 

IF<CENAME<1).EQ." OGO TO 316 

IFLAG-0 

DO 320 I-1/NUHEL3 
DO 325 >1/10 

IF<CENAME<J>.NE.EHAHES<I/J» GO TO 320 
325 IF<J.EQ.10>IFLAG«I 
320 CONTINUE 

IF<IFLAG.NE.0>G0 TO 330 
HRITE<LPUNIT/ 81 1 )<CENAHE< I)/ I-l / 10> 

GO TO 315 

ELEMENT IS FOUND/ SO LIST IT 

330 HRITE<LPUNIT/827XENAHES<IFLAG/ J)/>1/ 10) 
HRITE<LPUNIT/ 828> ESTC0L< IFLAG) 

MRITE<LPUNIT/829) EHIDTH< IFLAG) 

WRITE<LPUNIT/830) ETYPEUFLAG) 

IF<ETYPE< IFLAG). NE.'F')G0 TO 335 
NRITE<LPUNIT/831) DPLACE< IFLAG) 

335 NRITE<LPUNIT/ 832) <DESC( IFLAG/ J> , J-1 / 40) 

GO TO 315 

400 IF<ECOM.NE. 'F')CO TO 410 

GO BACK TO FORM SELECT 
GO TO 500 

410 IF<ECOM. HE. R')GO TO 425 

RESEQUENCE ELEMENTS COMMAND 

IF<NUMELS.NE.0)GO TO 411 
WRITE<LPUNIT/835XFNANEa)/I=l/10) 

GO TO 50 

411 IFCNUHELS.GT.DGO TO 412 
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HRITE<LPUNlT.852><FNMiE<X>«I-iae> 

GO TO 50 

412 CALL REORDR<NUHELS»ESTCOL^EHIDTH/DP'LACE/FNAHE> 
1 ENAHES/ETYPE.DESC/LPUNIT) 

GO TO SO 

ILLEGAL COhtHAND 

425 HRI1E<LPUNIT«833> 

REA0<5. 901 > END-425. ERR«425> YORN 
CALL LCASE<Y0RN> 

IF<YORN.EQ.'YO GO TO 500 
IF<YORN.NE.^NOGO TO 400 
GO TO 50 

FORH IS FULL OF ELEMENTS 

450 HR1TE<LPUNIT.834> 

GO TO SO 

RETURN TO MAIN PROGRAM 

see RETURN 


801 F0RHAT<//10X. 'SELECT AN ELEMENT FUNCTION i V/1 OX. 


'ENTER 
lOX. ' A 


3 ' D 

4 ' M 

5 ' L 

6 ' R 

7 ' F 

8 'COMMANDi ' 

802 FORHAT</10X. 

803 F0RMAT</10X. 
884 F0RHAT</10X. 


FOR THE FOLLOWING ELEMENT FUNCTION'// 
ADD AN ELEMENT'/IOX. 

DELETE AN ELEMENT'/IOX. 

MODIFY AN ELEMENT'/IOX. 

LIST AN ELEMENT'/IOX. 

RESEQUENCE ELEMENTS '/lOX. 

RETURN TO FORM COMMAND SELECT I ON '//I OX. 

.$> 

'NAME OF THE ELEMENT TO BE ADDED; '.4> 
'STARTING COLUMN OF THE ELEMENT; '.♦) 

'FIELD WIDTH OF THE ELEMENT; '.$) 


805 F0RMAT</10X. 

1 'ENTER FOR THE FOLLOWING ELEMENT TYPE'//10X. 

2 ' A ALPHANUMERIC ELEMENT'/IOX. 

3 ' I INTEGER ELEMENT'/IOX. 

4 ' X FILLER SPACE '/lOX. 

5 ' F FLOATING POINT OR DECIMAL ELEMENT '//I OX, 

8 'ELEMENT TYPE; '.») 

806 FORMAT</10X. 'DECIMAL PLACES IN FLOATING POINT ELEMENT; ',#) 

807 FORMAT</10X.'WILL THERE BE AN ELEMENT DESCRIPTION <Y/N>? M) 

808 FORMAT</10X. 'ENTER DESCRIPTION; '.4) 

809 FORMATv'/lOX. 'DO YOU WANT TO CONTINUE EXECUTING 
1 'ELEMENT OPERATIONS<Y/H)? '.4> 

818 FORMAT</10X. 'NAME OF THE ELEMENT TO BE DELETED; '.4> 

811 FORMAT</10X. 'ELEMENT '.lOAl.' NOT FOUND IN THIS FORM') 

812 FORMAT</10X. 'NAME OF THE ELEMENT TO BE MODIFIED; ',$> 

813 FORMAT</10X. 'DO YOU WANT TO CHANGE THE ELEMENT NAME <V/N>? ',!) 


814 FORMAT < / 1 OX • ' NEW NAME ; ' , # ) 

815 FORMAT </10X. 'DO YOU WANT TO CHANGE THE STARTING COLUMN Ct'/N)? ' 


1 .«) 

816 FORMAT </10X. 'NEW STARTING COLUMN: ' ,$> 

817 FORMAT </10X. 'DO YOU WANT TO CHANGE THE ELEMENT WIDTH *;Y/N)? ', 
1 t> 
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818 FORMAT</ieX.^NEH HIDTHt M> 

819 FORM«T</10X.'OO YOU H«NT TO CHANGE THE ELEHEHT TYPE ^V/N>? ',$> 
828 FORHAT</10X. 

FOR THE FOLLOHING ELEMENT TYPEOV'10^'; 
ALPHANUMERIC ELEMENTV10X/ 

INTEGER ELEMENT V10X> 

FILLER SPACEVlOX/ 

FLOATING POINT OR DECIMAL ELEMENT V/10X. 


1 'ENTER 

2 ' A 

3 ' I 

4 ' X 

5 ' F 


6 'HEN ELEMENT TYPEi '*$> 

821 FORMAT</10X/ 'NUMBER OF DECIMAL PLACES) 


,$> 


822 FORMAT</10X/'DO YOU HANT TO CHANGE THE ELEMENT DESCRIPTION'/ 


1 


<Y/N)7 '/♦) 


823 F0RMAT</10X/'NEH DESCRIPTION) ' ,$> 

824 FORMAT</10X/ 'FORM '»10A1/' CONTAINS THE FOLLOWING ELEMENTS)'/) 

825 FORMAT</10X, 'DO YOU HANT TO LIST AN ELEMENT <Y/N)T ',<) 

826 F0RMAT</10X/'NAME OF THE ELEMENT TO BE LISTED) ' ,$> 


827 FORMAT</10X« 'NAME OF THE ELEMENT) '.lOAD 


828 F0RMAT</10X/ 'STARTING COLUMN) '/I4> 


829 F0RMAT</10X. 'ELEMENT HIDTH) '^14) 


830 F0RMAT</10X/ 'ELEMENT TYPE) '/Al> 


831 F0RMAT</10X/ 'DECIMAL PLACES) '/I2) 

832 F0RMAT</10X/ 'DESCRIPTION) '»40A1> 


833 FORHAT</10X. 'ILLEGAL ELEMENT COMMAND/ LEGAL COMMANDS ARE A/D/H 


1 '/R OR L'/zlOX/ 

2 '<Y/N)7 ',<) 


'DO YOU HANT TO ISSUE A FORM COMMAND INSTEAD 


834 F0RHAT</10X/ 'THERE ARE 100 ELEMENTS CURRENTLY IN THIS'. 


1 ' FORM. THIS IS THE MAXIMUM' /' 1 0X/ 'HUMBER. IF'/ 

2 ' YOU HANT TO ADD A NEH ELEMENT/ '/10X/ ' YOU MUST DELETE'/ 

3 ' AN EXISTING ONE.') 


835 FORMAT</10X/ 'FORM '/10A1/' DOES NOT CONTAIN ANY ELEMENTS') 


836 FORMAT</10X/'THE STARTING COLUMN OF THE ELEMENT MUST 


1 'BE BETNEEN 8 AND 5120') 

837 FORMAT</10X/ 'HARMING) THE STARTING COLUMN OF THE ELEMENT IS'> 

1 ' GREATER THAN 131') 

833 F0RMAT(/10X/ 'THE ELEMENT HIDTH MUST BE BETWEEN O AND 5120') 

839 FORMAT</10X/ 'WARNING) THE ELEMENT WIDTH IS GREATER THAN'/ 

1 ' 131') 

840 FORMAT</10X/ 'ELEMENT '/lOAl/ ' HAS BEEN DELETED FROM THE FORM') 

841 FORHAT</10X/ 'THE NUMBER OF DECIMAL PLACES MUST BE IN THE'/ 

1 ' RANGE FROM 0 TO 5') 

842 FORMAT</10X/ 'ELEMENT NAME GIUEM EXCEEDS 18 CHARACTERS 
1 /10X/ 'ELEMENT NAME ENTERED « '/lOAD 

843 FORMAT</10X/ 'DESCRIPTION GIUEN EXCEEDS 40 CHARACTERS' 

1 /10X/ 'DESCRIPTION ENTERED » '/40AD 

844 FORMAT</10X/ 'AN ELEMENT WIDTH OF '/I4/ 

1 ' STARTING IN COLUMN '/I4/' EXCEEDS '/10X/ 

2 THE MAXIMUM LENGTH OF 5120') 

845 FORMAT </10X/ 'THE NUMBER OF DECIMAL PLACES MAY NOT / 

1 EXCEED ',12/'/ THE' /10X, ELEMENT WIDTH') 


846 FORMAT</10X/'INUALID ELEMENT NAME... ELEMENT ALREADY EXISTS 


847 FORMAT</10X/ 'ERROR) WIDTH OF AN INTEGER' 

1 ' ELEMENT HAS EXCEEDED 9 PLACES') 

848 FORMAT</10X/ 'ELEMENT FUNCTION) '/♦) 

849 FORMAT</10X/ 'ELEMENT TYPE: ',$> 

850 FORMAT</10X/'NEW ELEMENT TYPE) '/#> 

851 FORMAT</10X/ 'DO YOU HANT TO CHANCE THE NUMBER OF DECIMAL ' 
1 /'PLACES <V/N)? '/$) 

852 FORHAT</10X/ 'FORM '/10A1/' CONTAINS ONLY ONE ELEMENT / 1 OX/ 
1 'YOU CANNOT REORDER IT.') 

853 FORMAT</10X/ 'ERROR) THE INTEGER PART OF A FLOATING POINT' 


no 


t6SiiiijfeiChiinawr-iii^ 
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I ^lOX/TIELD HAY HOT EXCEED 9 PLACES ) 

901 F0RMAT<A1> 

902 F0RHAT(Q/10A1> 

903 F0RMAT<I4> 

904 F0RMAT<I2> 

909 FORHAT<Q/40A1> 

906 FORHAT<10A1> 

90r F0RHAT<6X/5<2X>10A1>> 

908 F0AHAT<10A1>I4/14.A1.I2/40A1> 

909 FORHAT<10Al/10A1.2I4/10m;214) 

910 F0RHAT<l0<50Al/>> 

END 

SUBROUTINE ELEUAL<CENAHE.ENAHE3/N’JHELS/NEHEL> 

THIS ROUTIHE DETERHIHES IF THERE IS AH EXISTIHC ELEHEHT 
IH THE CURREHT FORH OF THE SAh£ HAHE. IF THERE 1S> 
NEHEL IS SET TO 0/ IF HOT HEHEL *.S SET TO 1 . 

L0GICAL4>1 CENAHE<10>/EHAHES<100/10> 

HENEL>1 

DO 100 I-l.NUHELS 
DO 150 >1. 10 

IF<CEHAHE<J>.NE.EHAHES<I/J>>GO TO 100 
190 IF<J.EQ.ie>HEHEL>0 
1F<NEHEL.EQ.0>RETURH 
100 CONTINUE 
RETURN 
END 

SUBROUTINE REORDRCNUHELS. ESTCOL. EHIDTH^ DPLACE^ 

1 FHAHE/ENAHES.ETYPE/DESC.LPUNIT) 

THIS ROUTIHE REORDERS THE ELEMENTS HlTHIN A FORM 

INTEGER«2 NUHELS/ESTCOL< 100>> EHIDTHC 100) . DPLACEv 100) / 

1 KEYS< 100)/ TSTC0L< lOO) /THIDTH< 100) / TPLACEUOO) 

LOGICAL^I FNAHEC 10) / ENAHES< 100/ 10) / ETYPE< 100) / 

1 DESC< 100/ 40) / CEHAHE< 10) / TNAHE3< 100/ 10) / TTYPE< 100) / 

2 TDESC<100/40) 

COMMON/REUSE/CENAHE/KEYS/ TDESC/ THAMES/ TPLACE/ TSTCOL/ TTVFE/ 

1 THIDTH 

HRITE<LPUHIT/801XFHAHE<I)/I>1/10) 

N-NUHELS 

M-5 

K-N^M+l 
DO 50 I«l/K 
KB«i»M 
KA»K6~*4 

KB«MINe<KB/NUMELS) 

HRITE<LPUNIT/901)<<ENAHES<II/J)/J»1/10)/II-KA/KB) 

SO CONTINUE 

WRITE<LPUNIT/802)NUNELS/ <FNAME<I)/ 1-1/ lO) 

IPNT-1 

DO 100 I»1/NUMELS 

ENTER ELEMENTS IN NEH ORDER 
110 HRITE<LPUNIT/S03)I 

READ<5/ 902/ERR-110/END*! 10XCENAME< J) / J>1 / 10) 

ni 


1F<CEHAHE<I>.EQ.^ '>G0 TO UO 
C 

C FIND CURRENT POSITION OF ELEHENT 

C 

JFLRG-e 

DO 120 J-l.NUHELS 
DO 130 K-MO 

lF<CENAHE<K>.NE.ENRhtES<J/K>)GO TO 120 

130 IF(K.EQ.10>JFLPG-J 
120 CONTINUE 

IF<JFLAG.NE.0>00 TO 131 
C 

C ELEMENT IS NOT FOUND 

C 

HRITE<LPUNIT/e04><CENRHE<J>/>M0> 

GO TO lie 
C 

C CHECK TO SEE THAT ELEMENT HAS NOT ALREADY BEEN ENTERED 

C IN THE NEH ORDER 

C 

131 IFdPNT.EQ.DGO TO 140 
lBAD-0 

DO 135 II-ldPNT-1 
135 IF<KEYS<II>.EQ.JFLAG>IBAD«1 
1F<IBAD.EQ.0>G0 TO 140 
HRITE<LPUNIT.8O6><CENAME<J>/J-1.10> 

GO TO lie 

140 KEYS<IPNT>»JFLAG 
IPNT-IPNT+1 
100 CONTINUE 
C 

C NEH ORDER HAS BEEN ASSIGNED 

C 

DO 200 I-1.NUMELS 
>KEYS<I) 

DO 210 K«ldO 

210 TNAME3<I/K>-ENAMES<J>K> 

TSTCOL<I)-ESTCOL<J) 

THIDTH<I)»EHIDTH<J) 

TTYPE<I>«ETYPEU> 

TPLACE<I)-DPLACE<J) 

DO 220 K-1.40 
220 TDESC<I,K)-DESC(J>K) 

200 CONTINUE 
C 

C REMAP UALUES BACK TO ORIGINAL ARRAYS 

C 

DO 300 I-l/NUMELS 
DO 310 J-ld0 

310 ENAMES<I*J)»TNAMES<I,J> 

ESTCOLa>-TSTCOL<I> 

EHIDTH<I)«THIDTH<I) 

ETYPE<I>»TTYPE<I> 

DPLACE<I)«TPLACE<I> 

DO 320 >1/40 
320 DESCa/J>-TDESC<I/J> 

300 CONTINUE 

C 

C PRINT THE LIST OF REORDERED ELEMENTS 
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HRZTEaPUNITi8dS)(FNAHE<I><l-M0> 

N-NUHELS 

M*5 

DO 350 I"1^K 

KB-I'i'M 

KA»KB-4 

KB-H1N0<KB.NUHELS> 

HRITE<LPUNlT/9dl><<ENAHES<II^J>/>M0>/lI>KA/KB> 

350 CONTINUE 
RETURN 

801 F0RHRT</10X/ TORN MORl*^ CONTAINS THE FOLLOHING^ 

1 /lOX.^ELEHEHTS TO BE REORDERED) V> 

802 FORMAT </ lOX. ^HERE ARE A TOTAL OF M3/ ' ELEMENTS IN' 

1 FORM M0A1,'. V10X. 'ENTER EACH ELEMENT, 0»€ PER LINE' 

2 iw THE NEH ORDER:'/) 

803 FORMATS lOX. 'ELEMENT ',13,' • ',♦) 

804 F0RHAT</10X, 'ELEMENT ',10A1,' NOT FOUND IN THIS FORM.' 

1 /lOX, 'PLEASE REENTER NAME.') 

885 F0RMAT(/10X, 'FORM ',10A1,' HAS BEEN REORDERED. '/lOX, 

1 'THE NEH ORDER ISi'/> 

886 FORMAT</10X, 'ELEMENT ',10A1,' HHL ALREADY BEEN ENTERED IN' 
1 ,' THE NEH ORDER. '/lOX, 'PLEASE REENTER NAME ') 

981 F0RHAT<8X,5<2X, lOAD) 

902 FORMAT<10A1> 

END 


D. MTAIN • PROGRAM LISTING 
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cccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc 

c 

^ «4iiti4i^i«ti«iiti^«4tiMi4i4<«4>i|i4»<i4ii4i4ii«<!(i4>4<4<4>4i4<4i4i4>4<4^4i4i«4i4(4i4^4<if4i4<4i4i4t4iit(i«i4>4>i4<4i4‘4‘4ii4i4ii«i4ii4>4'4>4‘4i 

^ * * 

c ♦ * 

C ♦ TECHHOtOGV INCORPORATED ♦ 

C ^ LIFE SCIENCES DIVISION 

C « DEPARTMENT OP BIOHATHEHATICS SERUICES ^ 

C ♦ *•* 

C ^ 

C 4t 4* 

c ♦ ♦ 

C * PROGRAM NAME I DATAZN « 

C * DESIGICR/ANALYSTt CRAIG E. LITTON 

C * PROGRAMMER! SCOTT G. THOMPSON ♦ 

C * DATE 1 30 SEPTEMBER 1981 * 

C * * 

c * * 

c * — — * 

c ♦ ♦ 

c * * 

C ♦ COMPUTER SYSTEM) LSI-11. UAX-U/raO * 

C * OPERATING SYSTEM) RT-llv4. UAN/UMS * 

C ♦ ♦ 

c ♦ ♦ 

Q ♦— — — — — — — * 

c * ♦ 

C COMPILING SEQUENCE) * 

C * * 

C * LSI) REMOUE CLSI COMMENTS * 

C CREATE FILEl) MAIN. LCASE * 

C * CREATE FILE2) UALID.FETCH. SIZE. DATA ♦ 

C * CREATE FILE3) REPORT. HANG ♦ 

C * COMPILE 3EPERATELY) FORTRAN FILEN ♦ 

C * ♦ 

C * UAX) REMOUE CUAX COMMENTS * 

C * COMPILE) F0RTRAN/N0I4 DATAIN * 

C ♦ ♦ 

c * * 

c * * 

C * LINKING SEQUENCE) * 

C * * 

C * LSI-11/02) LINK/PROMPT/EXECUTE i^^ATAIN FILEl ♦ 

C ♦ ♦FILE2/0)1/C ♦ 

C » “FILEZ/O)!// ♦ 

C ♦ * 

C * LSI-11/23) LINK/PROMPT/LIB) FPU/EXECUTE) DATAIN FILEl * 

C ♦ *FILE2/0!l/C * 

C ♦ ♦FILES/O)!// * 

C * * 

C ♦ UAX) LINK DATAIN ♦ 

C ♦ * 

c ♦ 1‘ 

c * * 

C * EXECUTION SEQUENCE) RUN DATAIN * 
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FROCRAH DATAIN 


TECHNOLOGY INCORPORATED 
LIFE SCIENCES DIUI3I0N 
16021 BUCCANEER/ SUITE 206 
HOUSTON/ TEXAS 77058 

PROGRANHERi SCOTT C. THOMPSON 
DESIGNER/AHALYSTi CRAIG E. LITTON 

DEPARTMENT OF BIOHATHEHATICS 
23 JUNE 1961 


THIS PROGRAM IS DESIGNED TO ACCEPT DATA ENTRY THROUGH 
THE FORMAT DESCRIBED IN A DICTIONARY FILE. THE FORMAT 
FILE HILL HAUE BEEN CREATED THROUGH PROGRAM DICTIN, 


TABLE OF UARIABLES 


MAIN PROGRAM 


UARIABLE 

GOOD 

I 

IDSTCL 

lEND 

IJ 

IPNT 

I SETS 

IHIDTH 

J 

K 

NC 

MCI 

NFORMS 

NREPS 

NSIZE 

NUMBER 

NUMELS 


USE 

FLAG FOR FORM SEARCH IN DICTIONARY 

INDEX UARIABLE 

ID STARTING COLUMN 

LENGTH OF A SINGLE FORM RECORD 

INDEX UARIABLE 

CALL PARAMETER FOR FETCH 

NUMBER OF DATA SETS 

HIDTH OF THE ID 

INDEX UARIABLE 

INDEX UARIABLE 

NU^tBER OF CHARACTERS ON INPUT LINE 
NUMBER OF CHARACTERS ON INPUT LINE 
NUMBER OF FORMS SELECTED FOR DATA ENTRY 
NU'«ER OF REPETITIONS FOR A FORM 
LENGTH OF LONGEST FORM FOR DATA ENTRY 
m'/EX OF FORM FOR DATA ENTRY 
NUMBER OF ELEMENTS IN A FORM 


YORN 


YES OR NO 


DESC<160/46> ARRAY OF ELEMENT DESCRIPTIONS 

DICTIN<40> NAME OF DICTIONARY FILE USED 

DINDEX<56/16> NAhES OF ALL FORMS IN THE DICTIONARY USED 


DPLACE<100) DECIMAL PLACES IN THE ELEMENTS IN A FORM 

ENAMES< 106/ 16> NUMBER OF ELEMENTS IN A FORM 
ESr:OL<100) STARTING COLUMNS OF ELEMENTS IN A FORM 


ETVPE<100> 

EHIDTHa00> 

FILE<40> 

FNAHE<10) 

FNAMES< 10/20) 

IDa0> 

IUALUE<10> 

KEYS<20) 


DATA TYPE OF ELEMENTS IN THE CURRENT FORM 
HIDTH3 OF ELEMENTS FILDS 
NAME OF THE FILE TO STORE THE DATA 
NAME OF A FORM 

NAMES OF FORMS TO BE USED IN DATA ENTRY SESSION 
NA^C OF AN ID ON A PARTICULAR FORM 
UALUE OF THE ID 

LOCATION OF EACH FORM IN THE DICTIONARY USED 
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REPS<20> 

NUMBER OF REPETITIONS IN FIXED REP. FORMS 

TREP<2e> 

TYPE OF REPETITION FIXED OR UARIABLE 
SUBROUTINE UALID 

URRIRBLE 

USE 

GOOD 

FLAG FOR FORM SEARCH 

1 

INDEX UARIABLE 

IPLAG 

FLAG FOR FORM SEARCH 

J 

INDEX UARIABLE 

NFORHS 

NUHBER OF FORHS TO BE SEARCHED 

NUH 

INDEX OF FORH TO BE SEARCHED FOR 

DINDEX<50/ 10> 

DICTIONARY FORH NAMES 

FNRHES<ie^20> 

DATA ENTRY FORH KANES 

KEY8<2e> 

ARRAY STORAGE FOR IFLAGS 
SUBROUTINE FETCH 

SAME AS IN THE HAIN PROGRAM 
SUBROUTINE SIZE 

SANE AS IN THE HAIN PROGRAM 
SUBROUTINE DATA 

UARIABLE 

USE 

lA 

NUHBER OF DIGITS BEFORE THE DECIMAL POINT 

IB 

NUHBER OF DIGITS AFTER THE DECIMAL POINT 

ICOUNT 

ENDING INDICE 

lEPOS 

OUPUT RECORD INDEX UARIABLE 

ILEFT 

NUHBER OF CHARACTERS LEFT IN A RECORD 

ILINES 

NUHBER OF OUTPUT LINES 

lOUT 

END OF OUTPUT RECORD 

I START 

STARTING INDICE 

I TEST 

MAXIMUM SIZE FOR NUMERIC INPUT 

I UAL 

INTEGER INPUT UALUE 

ND 

NUHBER OF CHARACTERS IN THE DESCRIPTION 

ME 

NUHBER OF CHARACTERS IN THE ELEMENT FIELD 

OCUR 

OCCURANCE HUMBER 

RUAL 

REAL NUMBER INPUT UALUE 

DFHT<50) 

ARRAY TO BUILD FORMAT STATEMENTS 

DFMT2<50) 

ARRAY TO BUILD FORMAT STATEMENTS 

ELEUAL<5120> 

ELEMENT UALUE 

OREC<S120> 

OUTPUT DATA FORM RECORD 
SUBROUTINE REPORT 

UARIABLE 

USE 

IDEX 

INDEX FOR DATA SETS 

IGO 

READ FLAG 

IS 

STARTING COLUMN OF ELEMENT 

I SENT 

PRINTER FLAG 

lUNIT 

FORTRAN UNIT NUMBER 

RDEST 

REPORT DESTINATION 

REPFLAC 

FLAG TO DETERMINE IF SAME DATA SET 

RTYPE 

REPORT TYPE 

IREC<5120> 

INPUT DATA RECORD TO REPORT 

ITUAL<i0> 

TEMPORARY ID UALUE 

TREP<20) 

FORH REPETITIONS 
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c 

C UARIA6LE 

C 

C LINES 

C 
C 

C UARIA6LE 

C 

C R<26> 

C B<26> 

C IPUT 

C 
C 

c 
c 
c 

INTECER«2 REPS<20>> IDSTCL. IHIOTH.NUHELS. IEND.ESTC0L<10e>. 

1 ENIDTH<10e>.DPLRCE<IdO>/KEYS<20> 

LOGICRL^I FlLE<4e).DICTIN<40>.FNAHES<10/2e>/YORN.FNRHE<10>. 

1 ID< 10> . ENRHES< 100/ 10) /ETVPE< 100> / DESCC 100/ 40> / GOOD 

2 /DINTEX<S0/ 10>/ IURUJE<10>/TREP<20>/DFHT<rO> 
COHHON/Cl^FNAHE/ ID/ IDSTCL/ INIDTH/NUHELo/ lEND/ENRMES/ESTCOL/ 

1 ENIDTH/ ETYPE/ DPLflCE/ DESC/ lURLUE 

COMMONx C2/D I NDEX / NFORHS 
COHHON/ C3/ 1 XDUM < 5400 ) 

CLSI LPUNIW 

CUflX LPUNIT»6 

C 
C 

C PROMPT FOR FILE NAME TO USE FOR DATA 

C 

C 

WRITE<LPUNIT/800) 

100 WRITE<LPUNIT/e01) 

READ<5/ 901 / END«100/ ERR>100)NC1 / <FILE< I > / 1«1 / NCI > 
FIL£<NC1+1,'*0 
C 

C GET FILES CONTAINING FORMATS 

C 

200 WRITE<LPUNIT/802) 

READ<S..901/END=200/ERR«200>NC/ (DICTIN<I> / I=1/NC) 
DICTIN<NC+1>»0 

0PEN<UNIT»2/NAHE*DICTIN/ TYPE- 'OLD '/ ACCESS* SEQUENTIAL ' / 

1 FORM* FORMATTED '•/ DISPOSE* 'KEEP '/CARR I AGECONTROL* FORTRAN- / 
CUAX 2 RECORDS 1 2E*70 / ERR-200 / READONLY > 

CLSI 2 RECORDSIZE*70/ERR*2O0) 

README/ 905>NFORMS 

READ<2/ 906X <DINDEX< I / J> / J*1 / 10) / 1*1 / 50> 

C 

C PRINT NAMES OF FORMS IN DICflONARV 

C 

ENCODE <43/314/ DFNT > NC 
HRITE<LPUNIT/DFNT)<DICTIN<I)/I*1/NC> 

K*NF0RHS'5+1 
DO 210 1*1 /K 
KB-I+S 

KB»HIN0vKB/NFORMS) 

WRITE<LPUNIT/907><<DINDEX^II/J)/J*1/ iO>/II*KA/KE> 

210 CONTINUE no 


SUBROUTINE HANG 

USE 

NUMBER OF LINES DISPLAYED ON TERMINAL SCREEN 
SUBROUTINE LCASE 

USE 

UPPER CASE CHARACTERS 
LONER CASE CHARACTERS 
CHARACTER TO BE CONUERTED 


o o o o o o o o o ri o 


PROMPT FOR FORM NAMES AND REPETITIONS 

HRITE<LPUNIT>603> 

J«l 

ISETS-0 

300 HRITE<LPUNIT.804> 

READ<5/ 902XFNAMES< I . J> / 1>1 . 10> 

IF<FNANES<1/J>.EQ.^ -'>00 TO 350 
NUMBER-J 

CALL UAL1D<FNAMES/ NUMBER. GOOD/ KEYS. LPUNl O 
IF<GOOD.EQ. ^NOGO TO 300 

305 HRITE<LPUNIT.8U> 

READ<5.904>TREP<J> 

CALL LCASE<TREP<J>> 

IF<.NOT.<TREP<J>.EQ. 'F'.OR.TREP<J>.EQ."U >>G0 TO 305 
IF(:TREP<J>.EQ. 'F'>GO TO 310 
CALL FETCH<NUM6ER.KEYS> 

IF<1UALUE<1>.NE.^ OGO TO 306 
NRITE<LPUNIT.813> 

GO TO 305 

306 REPS<J> -32000 
GO TO 320 

310 HRITE<LPUNIT.805) 

READ<5.903)REPS<J) 

IF<REFS<J).GT.0.AND.REPS<J>.LE.10O)GO TO 320 
WRITE<LPUNIT.807> 

GO TO 310 
320 J-J+l 

IF<J.NE.21>G0 TO 300 


THENTY FORM MAXIMUM 
HRITE<LPUNIT.806> 

READ DATA ACCORDING TO SELECTED FORMS 


350 NFORMS-J-1 

KRITE<LPUNIT.810> 

CALL SIZE<KEYS.NSIZE.NFORHS> 

OPEN< UN I T» 1 . NAME-F I LE . TYPE- ' NEW " . ACCESS* ' SEQUENT I AL ' . 

1 FORM-'FORHATTED'' . DISPOSE* 'KEEP ' . CARRIAGECONTROL* FORTRAN . 

2 RECORDSIZE-NSIZE) 

400 ISETS-ISETS+1 

DO 2000 I*1.NF0RMS 
IPNT-I 

CALL FETCH<IPNT.KEVS> 

NREPS-0 

DO 1000 K*l.REPSa> 

IFaREP<.I).EQ. 'F')GO TO 990 

IFsK.NE.DGO TO 405 

401 WRITE<LPUNIT,815><FNAMEaj).IJ*1.10> 

READ<5.904>->-ORN 

CALL LCASE<YORN> 

IF»>-iORN.EQ. Y')GO TO 990 
IFOt'ORN.NE. N'>GO TO 401 
GO TO 2000 

405 HRITEaPUNIT.812XFNAMEaj>. IJ=1. 10> 
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READ<5>964>Y0RN 
CALL LCRSE<YOriN> 

IF<.NOT.<YORN.EQ.'Y'.OR.YORN.EQ.'NO)GO TO 405 
IF < YORN . EQ . 'N ' >G0 TO 2000 
990 IREP-K 

1000 CALL DATA<IREP.1SETS«LPUNIT> 

2000 CONTINUE 


ALL FORHS AND REPETITIONS HAUE BEEN READ 


2100 HRITE<LPUNIT/808> 

READ<5/904>YORN 
CALL LCASE<YORN> 

IF<YORN.EQ.'Y')GO TO 400 
IF<YORN.NE.^NOGO TO 2100 

CALL REPORT< ISETS,NFORHS/KEYS,REPS, NSI2E, TREP. LPUNIT> 


EXIT THE PROGRAM 


HRITE<LPUNIT/809) 
CL0SE<UNIT>1> 
CL0SE<UNIT»2> 
CALL EXIT 


800 FORMAT<//10X/ 'HELCOHE TO THE DATA ENTRY PROGRAMS) 

801 FORMAT</10X, 'FILENAME ON HHICH TO STORE THE DATA ' 

1 /10X> 'FILENAME. TYPE « ',<) 

802 FORMAT </10X/ 'NAME OF THE DICTIONARY TO BE USED FOR DATA ENTRY' 
I /10X/ 'FILENAME. TYPE « '>») 

803 F0RMAT<//1X, 'ENTER THE NAME OF EACH FORM TO BE USED AND THE ' 

1 /IX/ 'NUMBER. OF TIMES IT IS TO BE USED. WHEN FINISHED/ TYPE 

2 /IX/ 'A CARRIAGE RETURN IN RESPONSE TO FORMNAMEi'///) 

804 FORMAT < /2X / 'FORHNAME « '/$) 

805 F0RMAT<2X/ 'REPETITIONS » '/♦> 

806 FORNAT(//10X/ 'YOU HAUE NOW ENTERED TWENTY FORHS WHICH IS' 

1 /10X/'THE MAXIMUM NUMBER ALLOWED') 

807 FORMAT</10X/ 'REPETITIONS MUST HAUE A UALUE BETWEEN I & 10O') 

808 FORMAT </2X/ 'DO YOU WANT TO ENTER ANOTHER DATA SET <Y/N>? '/$) 

809 FORMAT<//10X/'SUCESSFUL EXIT FROM DATA ENTR’Y PROGRAM .... BYE ' > 
310 FORMAT <//'********+BEG IN ENTERING DATA*******++'///> 

811 F0RMAT</2X/ 'NUMBER OF FORM REPETITIONS! 

1 //2X/ 'ENTER'/ 10X/ 'FOR THE FOLLOWING TYPE' 

2 //4Xz F'/16X/ 'FIXED NUMBER OF REPETITIONS' 

3 /4X/ 'U'/16X/'UARIABLE NUMBER OF REPETITIONS' 

4 //2Xz 'COMMAND! ' ,$> 

812 FORMAT </2Xz 'DO YOU WANT ANOTHER REPETITION OF '/ 

1 FORM '/10A1/' <Y/N>? '/$) 

813 FORMAT </2Xz 'ERROR! THE CURRENT FORM DOES NOT CONTAIN AN'/ 

1 ' ID. '/2X/ -THE NUMBER OF REPETITIONS MAY NOT BE A' 

2 /2Xz - UARIABLE NUMBER WITHOUT AN ID.') 

814 FORMAT<'</10X/24HTHE FORHS IN DICTIONARY /'/I2/ A1/5H ARE!/)') 

815 F0RHAT</2Kz 'ARE THERE ANY REPETITIONS OF FORM zlOAl/ 

1 ' <V/N)? ',$> 

901 FORMAT<Q/30A1) ion 
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902 FORMATS 10A1> 

903 F0RMfiT<I3> 

904 F0RM«T<fil> 

905 F0RM«T<I2> 

906 FORMflT<9<50fll/)/50fll> 

907 F0RMfiT<8X.5<2X,iCHi>> 

END 

SUBROUTINE LCRSE<IPUT> 

THIS ROUTINE RETURNS AN UPPER CASE LETTER FOR A 
LONER CASE INPUT 

L0GICAL«1 A<26>/B<26>/IPUT 

DATA A^IHA. IHB/ IHC. IHD/ IHE. IHF. IHG/ IHH. IHI . IHJ. IHK. 

1 IHL. INN. IHN, IHO/ IHP/ IHQ/ IHR. IHS, IHT. IHU, IHU, IHN. IHX/ IHY. 1H2/ 
DATA B/lHa> IHb/ lHc> IHd/ IHi. IHf / IHl. IHh. IHi. IHJ/ IHk. 

1 IHl / lHm> IHn. IHO/ IH p/ lHr> IHi. IHt/ IHu. IHv. 1 Hm> IH x/ lHu> IHz/ 

DO 10 1-1/26 
1F<B<I>.NE.IPUT>G0 TO 10 
IPUT-A<I) 

GO TO 20 
10 CONTINUE 
20 RETURN 
END 

SUBROUTINE UALID<FNAHES/J/ GOOD/ KEYS/ LPUN IT > 

THIS ROUTINE SEARCHES THE DICTIONARY FILE TO HAKE 
CERTAIN THAT THE INPUT FORH IS A UALID NAME 


INTEGER*2 NFORHS/ IFLAG/KEYS<20> 

LOG I C AL‘«‘ 1 GOOD / D I NDEX < 50 / 1 0 > / FNAMES < 1 0 / 20 > 
C0MM0N/C2/ DINDEX/ NFORHS 


NUH-J 
I FLAG-0 

DO 100 1-1/ NFORHS 
DO 200 >1/10 

IF<FNAHE5<J/NUH>.NE.DINDEX<I/J)>G0 TO 100 
200 IF<J.EQ.10>IFLAG-I 

IF<IFLAC.NE.0>GO TO 300 
100 CONTINUE 

NR I TE < LPUN I T / 80 1 > <FNAHES < J/ NUH > / J= 1 / 1 0 > 
GOOD- N' 

RETURN 
300 GOOD-'Y" 

KE'i'S<NUH) = IFLAG 
RETURN 


801 FORMAT </10X/ 'FORH NAHE = MOAl/' NOT FOUND IN DICTIONARY' 
1 .'10X/ PLEASE REENTER THE FORH NAHEO 

END 

SUBROUTINE FETCHd /KEYS) 


o o o o o o o o 0(^0 n o o o o o o o 


C THIS ROUTINE RERDS IN ONE FORM AND ITS ELEhCNTS FRO^« 

THE DICTIONARY FILE HHICH HAS BEEN OPEN ON UNIT TNO 


INTECER'«‘2 IDSTCL^ INIDTH.NUHELS. IEND/ESTC0La00>>ENIDTH<10Cl^. 
1 DPLACE<IO0>.KEYS<2d> 

LOCICALM FNAHE<10>. ID<10>.ENAHES<iee. I0>. 

1 ETVFEv 10d> / DESC< 100; 40> ; IUALUE< 10> 

COHHON/Cl/FNAHE; ID; IDSTCL; INIDTH;NUHELS; IEND;ENAM£S;ESTCOL; 

1 ENIDTH;ETYPE;DFLACE;DE3C; lUALUE 


REMIND 2 
DO 10 K>I;11 
10 READv2;902> 

IF<KEVS<I).EQ.1>C0 TO 20O 
K-KEYS<I>-1 
DO 100 >1;K 
READ<2;901>NUHELS 
IF<NUHELS.EQ.e>GO TO lOO 
DO 50 JJ>1;NUHELS 
50 READ<2;902) 

100 CONTINUE 

200 READ<2; 903) <FNAHE< J) ; J*1 ; 10) ; < ID»; J) ; J*l ; 10) ; IDSTCL; IWIDTH; 

1 <IUALUE<J);J>1; 10);NUHELS; lEND 
IF<NUMELS.EQ.0)GO TO 300 
DO 250 >1;NUMELS 

250 READ < 2 ; 904 > < ENAHES < J ; K ) ; K= 1 ; 1 0 ) ; ESTCOL <. J ) ; EM I DTH J > ; ET VPE U ) , 
1 DPLACEvJ); (DESC<J;K);K=1;40> 

300 RETURN 


901 F0RHAT<3SX;I4> 

902 FORMAT a X) 

903 FORMAT<10A1; 10A1;2I4; 10A1;2I4> 

904 FORHAT<10A1;2I4,.A1; I2;40A1) 

END 

SUBROUT I NE S I ZE v KEYS ; NS 1 2E; NFORNS ) 

THIS ROUTINE ESTABLISHES iHICH RECORD IN THE 
GIUEN FORMS IS LONGEST AND RETURNS THE UALUE 
IN NSIZE 


INTEGER*2 KEYS<20) ; lEND 
COMMON^ C3' I ;J;K;N 


NSIZE>0 

DO 100 I«1;NF0RHS 
N»KEYS<I) 

REM INC' 2 
DO 150 J=l;ll 
150 R£AD<2;901) 

IF<N.EO. DGO TO 200 
K»N-1 
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DO 175 >1,K 
RE»V><2^ 9d2>NUHELS 
IF<NUh€LS.EQ.d>CO TO 175 
DO lee JJ-l.NUHELS 

lee READ<2.$ei) 

175 CONTINUE 

200 READ<2.903>IEND 

100 NSIZE«H<^XO<NSZZE/ IEND> 


901 FORMAT < IX) 

902 F0Rh«T<38X/I4) 

903 FORMAT <42X. 14) 

RETURN 

END 

SUBROUTINE DATA<0CUR/ ZSETS/LPUNIT) 

THIS SUBROUTINE READS IN THE DATA SUPPLIED BY THE USER 
AND STORES IT ACCORDING TO THE DICTIONARY FORMAT 


INTEGER^Z IDSTCL/ IHIDTH.NUNELS. lEND.ESTCOLaOO) / 

1 DPLACEa00)>EHIDTH<100)<0CUR 

INTEGER«4 I UAL > I TEST 

REALMS RUAL>RTEST 

LOG I CAL «• 1 FNAME < 1 0 ) / 1 D < 1 0 ) . ENAMES <100.10). ETYPE < 1 00 > . DESC < 1 OO . 40 ) 
1 , IUALUE<10).DFMT<70).ELEUAL<512O).OREC<512O).DFMT2<70) 

COHHON/Cl /FNAME. ID. IDSTCL. IHIDTH.NUMELS. I END. ENAMES. ESTCOL. 

1 EHIDTH. ETYPE. DPLACE.DESC. lUALUE 
COMMON/C3/DFMT . DFHT2 . ELEUAL. OREC 


ENTER DATA FOR EACH ELEMENT 


HRITE<LPUNIT.801)ISETS.<FNAME<I).I»1.10).OCUR 
lOUT-IEND 
DO 90 J-l.IOUT 
90 OREC<J)«" ' 

IF<IUALUE<1).EQ. ' OGO TO 96 
DO 95 J-l.lHIDTH 

95 0REC<IDSTCL-1+J)*IUALUE<J) 

ELEMENT LOOP 

96 DO 1000 I-l.NUMELS 
lEPOS-ESTCOLd) 

COMPUTE LENGTH OF DESCRIPTION 


DO 100 J«40.1.-l 
ND-J 

100 IF<DESC<I.J).NE. ' ')G0 TO 120 
BUILD PROMPT FOR DATA 
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c 

C NO DESCRIPTION TO USE RS HERDER/ USE ELEMENT NR^€ 

C 

DO 112 >1/10 
112 DESC(1/J>-£NRHES<1/J> 

DO 115 >ie/l/*l 
IF<DESC<1/J>.EQ.^ OGO TO US 
ND-J 

GO TO 120 
US CONTINUE 

120 NE-EN1DTH<I> 

IF<ETVPE<I).EQ.'ROGO TO 121 
IF<ETVPE<1>.EQ.'U>G0 TO 300 
IF<ETVPE<I>.EQ.'FOGO TO 400 
IF<ETYPE<I).EQ. 'X')GO TO 500 

121 IF<NE+ND+7<GT.75)G0 TO ISO 
C 

C TITLE RND ENTRY FIT TOGETHER ON THE SRHE LINE 

C 

ENCODE < 4 1 / 90 1 / DFHT X ND-«>7 > / NE / ND 
HRITE<LPUNIT/DFMT><DESC<I/J)/J-1/ND) 

CO TO 250 

150 IF(NE.GT.75>G0 TO 200 
C 

C ELEMENT FITS ON ONE LINE BY ITSELF 

C 

ENCODE < 42 / 903 DFMT > ND .• NE 
WRITE<LPUNIT,DFMTXDESC<I/J)/J«1/ND> 

GO TO 250 
C 

C ELEMENT TRKES UP MORE THRN ONE LINE 

C 

200 ILINES-NE/75 
CLSI ILEFT«M0DvNE/75> 

CVRX I LEFT- I MOD <NE/ 75) 

ENCODE < 1 3 / 906 / DFMT ) ND 
HRITEaPUNIT/DFNT><DESCa/J)/>l/ND) 

ICOUNT-0 

DO 210 J-1/1LIHE3 
C 

C ACCEPT MULTI LINE INPUT 

C 

HRITE<LPUNIT/904> 

ISTRRT-ICOUNT+1 

ICOUNT-ICOUNT+75 

READ < 5 / 905 > < ELEURL < K > / K- 1 START / 1 COUNT ) 

210 CONTINUE 

IF<ILEFT.EQ.O>GO TO 500 
ENCODE < 30 907 / DFMT > I LEFT 
HRITE<LPUNIT/DFMT) 

ISTART-ICOUNT+l 

ICOUNT-ICOUNT+ILEFT 

ENC0DE<8/ 902/ DFMT MLEFT 

READ < 5 / DFMT ) < ELEURL ^ K > / K= I START , ICOUNT ) 

GO TO 500 
C 

C ACCEPT ELEMENT INPUT/ IF SINGLE LINE 

C 

250 ENCODE v S / 902 / DFMT >NE 
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RE AD < 5 / DFHT > < ELEUAL < J > . J« 1 / ^iE > 

CO TO 500 
C 

C INTEGER ELEMENT 

C 

300 ENCXE<41/901«DFHT><ND4-7>.NE.ND 

301 HRITE<LPUNIT.DFHT><DESC<1.J>/>1/ND> 
READvS/ 913/ END>310>N. <DFHT< J> / J«1 / N) 

Nl-N 

DO 305 >N1/1/-1 
IF<DFMT<J).NE.' '>00 TO 306 

305 N-N-1 

306 1F<N.CT.NE> GO TO 307 
IF<N.LE.O> GO TO 310 
IF<N.GE.5> GO TO 320 
ENC0DE<5/914/DFHT2>N 
DECXE<N/ DFHT2/ DFMT/ ERR»307> lOAL 
GO TO 500 

307 HRITE<LPUNIT/916> 

GO TO 300 

310 IUAL-0 
GO TO 500 

320 ENC0DE<5/914/DFHT2)N 

DECODE<N/ DFMT2/ DFHT/ ERR«330> lUAL 
GO TO 500 
330 KD«0 

ENC0DE<7/915/DFMT2>N/KD 
DECODE vN / C-FMT2 / DFHT / ERR*307 >RUAL 
CUAX IF<DMOD<RVAL/DBLE<1.>).NE.0.)CO TO 307 

CLSl IF<AH0D<RUAL/1.>.NE.0>G0 TO 307 

N1»NE+1 

ENC0DE<7/915/DFMT2)N1/KD 
ENCXE<N1 / DFHT2/ ELEOADRUAL 
GO TO 510 
C 

C FLOATING POINT ELEMENT 

C 

400 lA-NE-DPLACECD-l 
IB-DFLACE<I> 

IF<IB.NE.O>CO TO 402 
ENCXE<45/917/DFHTKND+7>/IA/ND 
GO TO 401 

402 ENC0DE<53/ 908/ DFMT) <;ND+7> / lA/ IB/ND 

401 HRITE<LPUNIT/DFHT)(DESCa/J)/J«l/ND) 
READ<5/913/END«410)N/ <;DFMT<J)/ J*1 /N> 

DO 405 J«N/1/-1 

IFkDFMT<J).NE. ' ')G0 TO 406 

405 N»N-1 

406 IF<N.LE.0)GO TO 410 
IB>H1N0<IB/N> 

DO 421 J=l/N 

IFa'FMT<J).EQ.lH.)GO TO 422 

421 CONTINUE 
N=N+1 

DFHT<N)=1H. 

422 ENC0DEk7/9l5/DFMT2)N/IB 
DECODE N / DFMT2 / DFMT / tRR*407 RUAL 
RTEST«10.0**IA 
IF<RUhL.CE.RTEoT)GO to 407 
GO TO 500 
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407 WRIf£aPUNIT,91©> 

GO TO 400 

410 ROAL'O.O 

BUILD OUTPUT LINE BUFFER 

500 IF<ETVPE<I).EQ. 'fi'>G0 TO 510 
IF<ETVPE<I).EQ.'r>G0 TO 520 
IF<ETVPE<I).EQ.'X')G0 TO 530 
IF<ETVPE<I).EQ.T')G0 TO 540 

BUILD OUTREC IF ALPHA 

510 DO 511 >1^NE 

511 0REC<IEP0S-1+J)«ELEUAL<J> 

GO TO 1000 

BUILD OUTREC IF INTEGER 

520 ENC0DE<5/909.DFMT>NE 

ENCODE < NE . DFHT / OREC <1 EPOS >> I UAL 
GO TO 1000 

BUILD OUTREC IF FILLER 

530 ENC0DE<7.911,DFNT>NE 

ENC0DE<NE, DFHT, OREC«. lEPOS) ) 

GO TO 1000 

BUILD OUTREC IF FLOATING POINT 

540 ENCODE<7,912.DFHT>NE. IB 

ENCODE ^ NE, DFHT, OREC < lEPOS) >RUAL 

1000 CONTINUE 

PUT IDUALUE IN OUTPUT RECORD 


I«1 

DO 1001 J«IDSTCL,aDSTCL+IWIDTH-l) 
OREC<J)»IUALUE<I) 

1001 I>I<»-1 


HRITE COMPLETED RECORD TO DATA FILE 

HRITE< 1 . 910> <OREC< J) . J«1 . lOUT) 

RETURN 


801 F0RHAT</2X, 'DATA SETi M3>' FORMi MOAl,' OCCURANCEi 
1 I3/> 

901 F0RHAT<'<TM2. M2> '<1H_>, 1H>^1H+. M2. 

1 Al.OHi <,$>'> 

902 F0RMAT^ '<M4. 'Al>') 

903 FORNAT< ' < IX. ' . 12. A1 . IN: ^ IX. 1H<. . 12. ' 1H_> . 1H>/ 1H+. 1H<. #> ' > 

904 F0RHAT<1X. lH<.75aH.>. IH>/Iri+. 1H<.$> 

905 FORMAT <75A1/ 

900 FORMATC (IX. .12. Al.lHi)') 

907 FORMAT*. '<1X. 1H<. '. 12. MH->. 1H>/ 1H+. 1H<.I> > 

908 FORMAT< '<T '.12. ', 12 . IH.. .12. 
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</#) > 


I m/6Hi 

909 F0RmT< <IM2/')O 

910 F0KHAT<o4<d0Al>> 

911 F0RHflT<'<M4/'X)') 

912 FORH«T<'<F- ,I2/'.M1,0') 

913 FORHAT<Q/20m> 

914 F0RM«T<'(IM2/")O 

915 F0RHfiT<'<FM2/'.Ml, '>0 

916 F0RMf)T<2X/ "ERROR IN FIELD OH INPUT. .. .REENTER URLUE") 

917 F0RMflT<"<T", 12/ "/ 1H<. ", 12# "UH-)/ IN. # 1H>/1H^# ' # 12/ 

1 "m/6Nt </«>"> 

END 

SUBROUT INE REPORT^ I SETS/ NFORHS / KEYS / REPS / NS 1 ZE / TREP / LPUNI T > 

THIS SUBROUTINE SELECTS OPTIONAL PRODUCTION 
OF A TERMINAL AND/OR PRINTER REPORT ON THE 
DATA ENTERED. 

INTECER*2 REPS<20>/ IDSTCL/ IHIDTH/NUHELS/ lEND/ESTCOLUDO)/ 

1 EHIDTH<100>/DPLACE< 100>/KEYS<2O> / TREP<20> /REPFLG 

L0CICAL>»1 FILE<40>/DICTIN<40)/YORN/FNAHE<10>/ 

1 ID< 10) /ENAHES< 100/ 10) /ETVPE< 10O> / DE3C< 100/ 40> / GOOD 

2 /DINDEX<50/ 10)/ IUALUE<10>/RTYPE/RDEST/ IREC<S120>/ 

3 ELEOUT<5120>/DFHT<60)/ITUAL<10> 

INTEGER«4 lUAL 

REAL«4 RUAL 

COHMON/Cl/FNA^E/ ID/ IDSTCL/ IHIDTH/NUHELS/ lEND/ENAHES/ESTCOL/ 
1 EHIDTH/ETYPE/DPLACE/DESC/ lUALUE 

COMMON/C3/DFMT / DINDEX/ ELEOUT/ IREC 


ISEHT«0 

IFILE-0 

REPFLG-0 

IGO-0 

lUNIT-LPUNIT 
100 WRITE aPUNIT/S01> 

READ<5/901>YORH 
CALL LCASE<YORN> 

IF<YORN.EQ. 'N' /RETURN 
IF<YORN.NE.'Y")GO TO 100 

TYPE OF REPORT TO SEND 

200 WRITEvLFUNIT/602/ 

REWIND 1 
LINE3«0 

READ<5/90l>RTYPE 
CALL LCASE'RTVPE) 

IFxRTYPE.EQ. 'F .OR.RTYPE.EQ. 'U .OR.RTVPE.EO. B'/GO TO 300 
W.<ITE<LPUNIT/803) 

JO TO 200 

WHERE TO SEND IT 

300 HRITE<.LFUN1T/S04> 

READ<5/901>RDE3T 
CALL LCASE<RDEST> 

IF <RDEST . EQ . ' T ' . OR . RDEST . EG . P " . OR . RDEST . EG . F . OR . RDEST , EG . ' A ' > 
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I GO TO 390 
HR1TE<LFUNIT.603> 

GO TO 300 

390 1F<RI>EST.EQ.'P'.OR.RC€ST.EO.TOGO TO 2000 

400 CONTINUE 

IF<RTVPE.EQ.'UOGO TO 470 
C 

C BUILD OUTPUT RECORD <F0RHATTED> 

C 

DO 450 IDEX-l.ISETS 
DO 500 1-I/NFORHS 
IPNT-I 

CALL FETCH<1PNT.KEYS> 

DO 600 K«1.REPS<I> 

IF<IG0.EQ.1>G0 TO 409 

READ< I . 903/ END-470) < IREC<J>/ >I /NSIZE) 

401 IF<TREPU).EQ.'F">GO TO 409 
C 

C UARIABLE NUHBER OF REPETITIONS 

C 

JJ-1 

DO 402 J-IDSTCL/<IDSTCL+IHIDTH>1) 

ITUAL<JJ)-IREC<J) 

402 JJ-JJ-t-1 
REPFLG-0 

DO 403 J-l/IHIDTH 

IFaTUAL< J) .NE. IUflLUE<J>)REPFLG-l 

403 IFvREPFLG.EQ.DGO TO 550 
C 

C BUILD OUTPUT REPORT FOR EACH FORM 

C 

409 IGO-0 

DO 1000 KK-l/NUHELS 
C 

C COMPUTE LENGTH OF DESCRIPTION 

C 

DO 410 J«40/1/t1 
ND-J 

410 IF<DESC<KK/J).NE." OGO TO 425 
C 

C NO DESCRIPTION/ USE ELEMENT NAME 

C 

DO 415 J-1/10 

415 DESC<KK/J)-ENAME3<KK/J> 

DO 420 J-10/1/-1 
NC»-J 

420 If<DESC<KK/J).NE.' ')G0 TO 425 
C 

C FOR EACH ELEMENT 

C 

425 IF<.N0T.<<I.EQ.1).AND.(K.EQ.1).AND.<KK.EQ.1^))G0 TO 430 
C 

C 

C NEH DATA SET 

C 

C 

IF<IDEX.EQ.1)G0 TO 426 
CALL HANGsLINES/IUNIT/LPUNIT) 

LINE3-0 

426 IF< lUNIT.NE .6>HRITEv lUNIT/ 909> 
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NRITEaUNlT/605>IDEX 
LlNES-LINES^l 

1F<L1NES.CE.21>CM.L HANC<L1NES. lUNIT.LFUNIT) 

430 IF<KK.»€.1>G0 TO 440 

HEN FORH 

lF<l.EQ.nOO TO 435 
CALL HAHG<LINES.IUNIT.LPUNIT> 

LINES-0 

435 HR1TE<1UNIT/806>(FNAHE<J><>M0>/K 
LlNES-LlNES+1 

1F<L1HES.GE.21>CALL HANG<LlNESi lUNIT.LPUNIT) 

CHECK SIZE OF OUTPUT LINE 

440 NE"EHIDTH<KK> 

IS-ESTCOL<KK> 

JJ-1 

00 445 J-IS/<IS<»NE-1> 

ELEOUT<JJ>-IREC<J> 

445 JJ-JJ+l 

IF<<ND+HE+11).CT.75>G0 TO 446 

ELEMENT AND DESCRIPTION FIT ON THE SAME LINE 
IKK*KK 

EHC0DE<37/ 902^ OFHT> IKK/ NO/ NE 

HRITE< IUNIT/DFMTXDESC< IKK/ J> / J-1 / NO) / <ELEOUT< J> / >1 / NE) 
LIN£3>LINES-»-l 

IF<LINES.GE.21)CALL HANC<LINES/ lUNIT/LPUHIT) 

GO TO 1000 

ELEMENT HILL OCCUPY SEPERATE LINES FROM THE DESCRIFHON 

ENCO^<23/905/DFMT)IKK/ND 
HRITE< lUNIT/ DFMTXDESC< IKK/ J) / J-l / NO) 

LINES-LINES>1 

IF<LINES.GE.21)CALL HANGaiNES/ lUNIT/LPUNIT) 

ILINES-NE/75 
CLSI ILEFT»M0CKNF/75> 

CUAX ILEFT-IM00<NE/75) 

I COUNT -0 

IF<ILINES.GT.O)GO TO 460 
435 ENCODE<17/906/DFMT)ILEFT 

HRITEaUNIT/DFMTXELEOUT<J)/J«l/ILEFT) 

LlMES-LlNES-fl 

I F < L I NES . GE . 2 1 ) CALL HANG v L I NES / 1 UN I T / LPUN I T > 

GO TO 1000 

460 DO 465 J>1/1LINES 
ISTART-ICOUNT+1 

ICOUNT-ICOUNT+75 

HRITE<IUNIT/907XELEOUT<JJ)/JJ»ISTART/ICOUNT> 

L1HES«LINES-»>1 

1F<LINES.GE.21)CAU HANG<LINES/ lUNIT/LPUNIT) 

465 CONTINUE 

IFaLEFT.EQ.O>r lOOO 
ISTART»ICOUNT . 

ICOUNT»ICOUNT+ILEFT 
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ENCOC€< 17/ 9e6/DFMT> ILEFT 

NR I TE< lUNIT/ OFHTXELEOUT< J> / J- ISTfWT/ ICOUNT) 

LINES-LINES^l 

1F<LINE8.GE.21>CRLL HRNG<L1NES/ lUHIT/LPUNIT) 
1080 CONTINUE 
600 C014TINUE 

590 IF<REFFLG.EQ.1>1G0-1 
REPFLC-0 
500 CONTINUE 
450 CONTINUE 
C 

C ISSUE UNFORMATTED REPORT 

C 

470 IF<RTYPE.EQ.^FOGO TO 2000 
IF<IUNIT.NE.6>NRITE(IUNIT/909> 
IF(.RTYPE.EQ.'BOCALL NANCdlNES/ lUNIT/LPUNIT) 
HRITE<IUNIT/d08> 

LINES«LINES^3 

IF<LINES.GE.21>CALL HANG<LINES/ lUNIT/LPUNIT) 
REWIND 1 

1100 READ( 1/903/ END-2000) <IREC<J>/J>1/NSIZE) 
IL1NE3-NS1ZE/80 
1F(ILINES.GT.0)GO TO 1250 
NRITE< lUNlT/ 900X IREC< J> / >1 / NSIZE) 
LlNES-LINES't'l 

IF<L1NES.GE.21)CALL NANG<LINES/ lUNIT/LPUNIT) 

GO TO 1175 
C 

C RECORD IS LONGER THAN 80 COLUMNS 

C 

1250 lCOUNT-0 

DO i30O J-l/ILINES 

ISTART-ICOUNT+1 

ICOUNT-ICOUNT4-00 

1300 WRITE<IUNIT/908XIREC(K)/K-ISTART/ICOUNT> 
LINES-LINES-t-1 

IF<LINES.CE.21)CALL HANG<LINES/ lUNIT/LPUNIT) 
CLSI IF<HOD<NSIZE/80>.EQ.O)GO TO 1175 

CUAX IF<IHOD<NSIZE/30).EQ.0)GO TO 1175 

CLSI lLEFT-MOD<NSIZE/80) 

CUAX lLEFT-IMOD<NSIZE/80> 

ISTART-ICOUNT+1 

ICOUNT-ICOUNT+ILEFT 

WRITE<IUNIT/908XIREC<K)/K«ISTART/ICOUNT> 

LINES-LINES-t-l 

IFaiNES.GE.21)CALL HANG<LINES> lUNIT/LPUNIT) 
1175 CONTINUE 
GO TO 1100 
C 

C IF REPORT DESTINATION IS THE LINE PRINTER 

C 

2000 IF<RDrST.EQ.'TOGO TO 2580 

IF<RDEST.EQ.^P^0R.IFILE.EQ.1>G0 TO 2100 
REWIND 1 
IUNlT-3 
C 

C SAUE THE REPORT 

C 

HRITE<LPUNIT>811) 

READ<5/910)NC/<FILE<I)/I«l/NC) 
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FILE<NC-»>n«0 

OPEN<UNlT-3/NAH£-FILE/^YPE•^NEH^0CCESS•^SEQlllENTI0L^ 

1 F0RH«''F0RHflTTED',0I8F0SE»'KEEP'/ 

2 CARRIOCECONTROL-^FORTRANO 
HR1TE<LPUNIT.612><FILE<I>^ I-l/NO 
1FILE>1 

GO TO 400 
C 

C PRINT THE FILE AND DELETE IT 

C 

2100 1F<I3ENT.EQ.1.0R,RDEST.EQ.TOGO TO 2500 
CLSI lUNIT-6 

COAX IUN1T>4 

COAX 0PEN<UNIT-4,NAME-'0ATIN.0UT^TYPE-'NEW^ACCESS-"SEQ0ENTIAL', 

COAX I FORM-'FORMATTED^OISPOSE-'PRINT/DELETE', 

COAX 2 CARRIAGECONTROL-^FORTRAN''/RECL»S120> 

WRITE<LPUNIT,809) 

REMIND 1 
ISENT-l 
GO TO 400 
C 

2500 CONTINUE 
C 
C 
C 
C 

801 F0RMAT</2X, 'DO YOU HANT A REPORT ON THE DATA ENTERED <Y/N)'. 

1 '? ',») 

802 F0RMAT<//2X/ 'TYPE OF REPORT TO OUTPUT i ' 

1 //2X> 'ENTER', lOX. 'FOR THE FOLLOWING REPORT TYPE' 

2 //4X, 'F' , 16X, 'FORMATTED REPORT WITH TITLES' 

3 /4X, '0' , 16X, 'UNFORMATTED FILE' 

4 /4X, 'B' , 16X, 'BOTH REPORTS' 

5 //2X, 'COMMAND! ',♦) 

803 F0RMAT</2X, 'ILLEGAL COMMAND, TRY AGAIN') 

804 F0RMAT<//2X, 'DESTINATION OF THE REPORT)' 

1 //2X, 'ENTER', 10X, 'FOR THE FOLLOWING REPORT DESTINATION' 

2 //4X,'T',16X, 'TERMINAL PRINTOUT' 

3 /4X, 'P' , 16X, 'PRINTER COPY' 

4 /4X, 'F' , 16X, 'FILE COPY' 

5 /4X,'A',16X,'ALL OF THE ABOOE' 

5 //2X, 'COMMAND: ',f> 

805 F0RMAT</2X, 'DATA SET NUMBER ',14) 

806 F0RMAT</2X, 'FORM ',10Al,' OCCURANCE NUMBER ,14) 

307 F0RMAT</2X, 'TYPE RETURN TO CONTINUE') 

80S F0RMAT<//2X, 'UNFORMATTED REPORT'/) 

809 F0RMAT(/2X, 'DATA REPORT HAS BEEN SENT TO THE LINE PRINTER'/) 

810 F0RMAT</2X, 'DO YOU W«^T TO FILE THE REPORT AFTER PRINTING' 

1 ,' IT <Y/N)? ',♦) 

811 F0RMAT</2X, 'NAME OF THE FILE TO STORE THE REPORT' 

1 /2X, 'FILENAME. TYPE » ',») 

812 F0RMAT</2X, 'DATA REPORT HAS BEEN COPIED AND' 

1 /2X, 'FILED UNDER FILENAME * ',43A1) 

901 F0RMAT<A1) 

902 F0RMAT<'<1X.4H',I3, '),2X,',I2,'A1,4H: <, ', 14, 'Al, 1H»') 

903 FORMAT<64<80AD) 

904 FORMAT < IX) 

905 FORMAT< ' < IX, 4H' , 13, ' ) , 2X, ' , 12, 'Al , IH : > ' ) 

906 FORMAT< ' < IX, 1H<, ' , 12, 'Al , 1H» ' ) 

907 F0RMAT<1X,1H<,75A1,1H» 
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90S F0RMAT<lX/8eAl> 

909 F0RH«T<1H1) 

910 FORHRT(Q«40R1> 

RETURN 

END 

SUBROUTINE HRNG<LINES/ lUNIT.LPUNIT) 

STOPS OUTPUT NHEN SCREEN IS FULL 

IF< lUNIT.NE .LPUI'IIT>RETURN 
HRITE<LPUNIT.e01> 

RERD<5/901> 

LINES-0 

RETURN 

801 FORMRT</2X/ "TYPE RETURN TO CONTINUE i 
901 FORHftT<lX) 

END 
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PROGRAM LEDIT 


TECHNOLOGY INCORPORATED 
LIFE SCIENCES DIVISION 
16821 BUCCANEER DRIUE. SUITE 286 
HOUSTON. TEXAS 77058 

AUTHOR! CRAIG E. LITTON 
PROGRAHHERi SCOTT G. THOHPSON/UER3ION 1.0 
DEPARTMENT OF 6I0HATHEHATICS 
16 MARCH 1981 


UERSION 3.0 - 32K LSI. 3200 LINE MAXIMUM 

- 64K TO 128K LSI. 6400 LINE MAXIMUM 

- UAX. NO LINE MAXIMUM 

THIS PROGRAM 13 DESIGNED TO EDIT TEXT FILES IN A LINE 
ORIENTED MODE. IT ELIMINATES CURSOR AND BUFFER POSITIONING 
PROBLEMS. THE COMMANDS ARE FEH AND SIMPLE. THE COMMAND 
SYNTAX IS) 


COMMAND I /STRING ONE/ . /STR I NG TNO/ . COUNT 
NHERE COMMAND IS ONE OF THESE i 


RESET OR R TO MOUE THE LINE POINTER TO THE 
FIRST LINE; 

SET OR S TO MOUE THE CURRENT LINE POINTER 

RELATIUE TO ITS CURRENT LINE 
POSITION - UPWARD TO THE TOP 
OR BEGINNING OF THE FILE IF 
N IS NEGATIUE - DOWNWARD OR 
TOWARDS THE BOTTOM OF THE FILE 
IF N IS POSITIUE. 


NUMBER OR N TO COUNT THE NUMBER OF LINES TO 

THE END OR TOP OF FILE FROM THE 
CURRENT LINE POSITION. 


LIST OR L TO LIST THE CURRENT LINE. OR IT 
AND SEUERAL PRECEEDING OR 
FOLLOWING LINES. 

FIND OR F TO RESET THE POINTER FORWARDS 
OR BACKWARDS AND LIST THE 

LINE. 


ADD OR A TO ADD TEXT LINES AFTER THE 

CURRENT LINE, 


DELETE ORD TO DELETE A LINE OR LINES- 

REPLACESTRING 
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OR RS TO rHRNGE « STRING OF TEXT IN 
R LINE OR LINES; 

DELETE STRING 

OR DS TO DELETE R STRING OP TEXT IN R LINE 

OR LINES. 

EXTRRCT OR E TO EXTRACT R COPY OF ONE OR 

MORE LINES RND PUT IT/THEH 
INTO R HOLDING BUFFER. 


CLERR OR C TO CLERR THE EXTRRCT I ON HOLD 
BUFFER; 

STOP TO EXIT THE PROGRRH WITH NO 

CHANGE TO THE FILE; 


END TO EXIT THE PROGRRH WITH THE 

EDITED CHANGES IMPOSED ON 
THE FILE. 


I IS REQUIRED TO SEPERRTE THE COMMAND STRING FROM ANY 
QUALIFYING STRINGS. IF A STRING IS TO BE SPECIFIED. 


/STRING/ IS ANY TEXT STRING ENCLOSED BY A PAIR 

OF ANY CHARACTERS. THE DELIMITERS CAN BE ANY 
CHARACTER AS LOl'iG AS THEY ARE THE SAME. THEY ARE 
NOT CONSIDERED PART OF THE STRING. 


SET I /STRING/ 


MOUES THE CURRENT LINE POINTER 
TO THE FIRST LINE THAT 
CONTAINS THE STRING. 


NUMBER; /STRING/ COUNTS THE NUMBER OF LINES 

FORWARD THAT CONTAIN THE STRING. 

LIST; /STRING/ LISTS THE FIRST LINE THAT 
CONTAINS THE STRING. 

WITHOUT MOUING THE POINTER. 

FIND; /STRING/ LISTS THE FIRST LINE THAT 
CONTAINS THE STRING. AND 
MOUES THE CURRENT LINE POINTER 
TO THAT LINE. 


ADD; /STRING/ 


ADDS TEXT AFTER THE FIRST LINE 
THAT CONTAINS THE STRING. 


DELETE; /STRING/ DELETES THE FIRST LINE FORWARD 
THAT CONTAINS THE STRING. 


RS: /STRING ONE/. /STRING TWO/ 

CHANGES THE FIRST OCCURANCE OF 
"STRING ONE" TO BE "STRING TWO". 


EXTRACT: /STRING/ EXTRACTS A COPY OF THE FIRST 
LINE CONTAINING THE STRING 
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; IS REQUIRED TO SEPARATE THE COHMAND/ OR THE 
COHHAHD AND AHV STRINGS FROM THE COUNT. 

COUNT IS A POSITIUE OR NECATIUE INTEGER NUHEER 
WHICH SPECIFIES THE NUMBER OF LINES MORE 
THAN BUT INCLUDING THE CURRENT LINE UPON 
WHICH THE COMMAND MUST OPERATE. THE DEFAULT 
UALUE OF COUNT IS ALWAYS ONE. IF AN « IS USED 

INSTEAD OF A NUMBER/ ALL LINES TO THE END OF 

FILE ARE AFFECTED. IF A is USED/ ALL LINES 
TO THE TOP OF FILE ARE AFFECTED. 

SET/N HOUES THE CURRENT LINE POINTER 
FORWARD FOR POSITIUE N/ 

BACKWARD FOR NEGATIUE N. 

LIST.N PRINTS N LINES INCLUDING THE 

CURRENT LINE/ BUT DOES NOT 

HOUE THE CURRENT LINE POINTER 

IF N IS POSITIUE/ LINES AFTER 
THE CURRENT LINE ARE PRINTED. 

IF N IS NEGATIUE/ LINES BEFORE 
THE CURRENT LINE ARE PRINTED. 
L.E PRINTS ALL THE LINES IN 
THE EXTRACTION BUFFER. 

FIND,N MOUES THE CURRNET LINE POINTER 
FORWARD OR BACKWARD AND 
LISTS THE NEW LINE. 

ADD.N ADDS THE TEXT AFTER THE N'TH LINE 
FORWARD OR BACKWARD. 

DELETE. N DELETES N LINES FORWARD OR BACKWARD. 

RSi/A.'//B/.N CHANGES N OCCURANCES OF STRING 
"A" TO "B" 

EXTRACT. N EXTRACTS N LINES INTO THE BUFFER 

WHEN BOTH QUALIFYING STRINGS AND COUNT ARE 
SPECIFIED/ THE OPERATIONS ARE COMBINED 
TO EXECUTE ON THE SPECIFIED LINES. 

WHEN ADDING TEXT/ AFTER ENTERING THE ADD COMMAND. 

THE EDITOR WILL RESPOND WITH: 


ENTER TEXT: 

I 

THE UERY FIRST CHARACTER TYPED BECOMES THE 
DELIMITER FOR THE TEXT ENTERED. TEXT ENTERING 
CONTINUES UNTIL THE LAST CHARACTER TYPED IS 
THE SAME AS THE FIRST OF THE TEXT ENTERED. 

TO USE THE EXTRACTION BUFFER AS THE SOURCE OF 
THE TEXT TO BE ADDED. TYPE $ AS THE UERY FIRST 
CHARACTER ON THE LINE AND A COPY OF THE CONTENTS 
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c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


c 


OF THE EXTRACT lOH BUFFER HILL BE UBED INSTEAD 
OF NEH TEXT. 

IF VOU TYPE A CARRIAGE RETURN AS THE FIRST 
CHARACTER OF THE FIRST LINE THE TEXT USED WILL 
BE THE SAHE AS THAT USED IN THE LAST ADD 
OPERATION. 

NOTES TO UERSION 3.0 (SEPTEMBER 30/lS31>i 
ONLY THE A« t>, DS/ F, L. N, RS. AND S USE THE 
STRING OPTIONS. 


INTEGER«2 YORN> RECNUH/CURRLP. THISRC. FIRSTR. CLINE < 90) , CTYPE. 

1 HORKLP « ALAST/ COUNT , PPEC ^ TRANSB / TRANS7 ^ TRANS3 > TRANSL . 

2 TRANSS. SBUFF> FILE<8> . TRANSA/ TRANSD 


L0GICAL«1 UFILEa6>.B3USED.B4USED.LINEa37)/LINE2(137>. 

1 STRl<dl>.STR2<dl>.NEHFIL/ALLUP.ALLDHN.IADEL^UFILEBa6>/ 

2 DALLUP.DALLDN 
C 

CLSI32 INTEGER«2 KBUFF(6/B4aO>.SBUFF<25B. 10> 

CLSIe4 UIRTUAL KBUFF(e.B4/49>«SBUFF(25D«6e> 

CLSI96 UIRTUAL KBUFF<B,B4>8S>.SBUFF<256. 127) 

CLSI128 UIRTUAL KBUFF<6,64/S5).SBUFF<256, 127> 

CUAX UIRTUAL KBUFF(6>64,85>.SBUFF<256. 127> 

C 

C 

C 


COHHON^CPARSE/NCLINE. CLINE, CTVPE, COUNT. S7R1.STR2. NSTRl. 
1 NSTR2,ALLUP.ALLDHN 
COHMON/KEVS/KX < 253 > 

COMMON/ TEXT/ 1 SX < 642 ) 

COMHON/LP/LPUNIT 
COMMON/MSIZE, INDREC. KNTKB. KNTS6 
CLSi DATA LPUNIT/7/ 

CLSi32 DATA INDREC.KNTKB.KNTSB/SO. lO. 10/ 

CLSI64 DATA INDREC.KNTKB.KNTSB/ 108.49 >68/ 

CLSI96 DATA INDREC.KNTKB.KNTSB/100.S5. 127/ 

CLS I 1 28 DATA INDREC . KNTKB . KNTSB/ 100.85.127/ 

CUAX DATA LPUNIT/6/ 

CUAX DATA INDREC. KNTKB. KNTSB/ 100. 85. 127/ 

C 

C 

C 

KBUFF(1.1.1)»0 

CURRLF-0 

NUMREC^O 

LASTRC=0 

F1R£TR=0 

B3USED=.FAL3t. 

B4USED*. FALSE. 

NEWFIL*.FALSE. 

ALAST=0 
DALLUP*. FALSE. 

DALLDN*. FALSE. 

C 138 


c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


CLSI 

CUAX 

c 


OPEN FILES I 


UNIT DEUICE FILE USE 


1 

2 

3 

4 

5 
7 

n 


DKt ZZZZl.LED POINTERS TO UNIT 2 

DKi ZZZZ2.LE0 WORKING COPY OF THE EDITING FILE 

DKi ZZZZ3.LED EXTRACTION BUFFER FILE 

DKi ZZZZ4.LED llDD BUFFER FILE 

TT I (INPUT) TERHINAL INPUT 

TT I (OUTPUT) TERMINAL OUTPUT 

USER FILE FOR EDITING 


OPEN(UNIT»l > NAHE-^ZZZZl . LED^ TYPE- 'SCRATCH " . ACCESS- ' D IRECT ' , 

I FORM- ' UNFORMATTED ' , RECORDS IZE-334 . ERR-9S9 1 . D I SPOSE- ' DELETE ' 

2 .CARRIAGECONTROL-'NONE' / ASSOCIATEUARIABLE-PREC; MAXREC-lOO) 

2 .CARRIAGECONTROL-'NONE' . ASSOCIATEUARIABLE-PREC) 

OPEN( UN I T-2 . NAME- ' 22ZZ2 . LED ' / TYPE- ' SCRATCH / ACCESS- 'DIRECT'/ 

1 FORM- ' UNFORMATTED ' / RECORDS I ZE-256 / ERR-S9S2 / D I SPOSE- ' DEL-'TE ' / 

2 CARR I AGECONTROL- ' NONE ' / ASSOC I ATEUAR I ABLE-RECNUM ) 


C 

OPEN(UNI T-3/ NAME- '22Z23 . LED' , TYPE- ' SCRATCH' / ACCESS- 

1 ' SEQUENT I AL ' / FORM- ' UNFORMATTED ' / ERR-99S3 / D I SPOSE- ' DELETE ' ; 

2 CARRIAGECONTROL-'NONE ) 

C 

OPEN< UN IT-4/ NAME- '22224 . LED ' / TYPE- ' SCRATCH ' / ACCESS- 

1 SEQUENT I AL ' / FORM- ' UNFORMATTED ' / ERR- 99 94 / D I SPOSE- ' DELETE ' / 

2 CARRIAGECONTROL-'NONE) 

CALL RECMGR(e/0/Kl/K3/K4/K5/ lERR/KBUFF/ SBUFF) 

CALL SETLC 
C 

C PROMPT FOR USER FILE NAME 

C 

100 WRITE(LPUNIT/901) 

DO 110 J-1/16 

110 UFILE<J)«0 

READ < 5 / 808 / END- 1 00 / ERR- 1 00 ) NCU / < UF I LE < J ) / J- 1 / NCU > 

C 

101 HRITE<LPUNIT/902) 

READ<5/ 802/ END-101 /ERR-lOl) YORN 
IF<V0RN.EQ.1 Hm> YORN-IHY 
IF< YORN . EQ . IHn) YORN-IHN 
C 

1F<V0RN.NE. 'V'. AND. YORN. NE. 'N') GO TO lOl 
IF<YORN.EQ. 'N') GO TO 200 
C 

C NEW FILE 

C 

NEWFIL-.TRUE. 

0PEN(UNIT*1 1 / NAHE-UFILE/ TYPE- NEW ’ / ACCESS- ' SEQUENTIAL ' / FORM* 

1 -FORMATTED' /DISPOSE- 'KEEP' / CARR I AGECONTROL- FORTRAN / 

2 ERR-500) 

C 

REWIND 11 
ENDFILE 11 
REWIND 11 
GO TO 800 
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C OLD FILE^ COPY TO UNIT 2 

C 

200 OFEN< UNI T- 1 1 . NANE«UF ILE/ TYPE- ^ OLD ^ ACCESS- ' SEQUENTIAL ' / FORM- 
l FORMATTED D I SPOSE- ' KEEP ' . CARR I AGECONTROL- "FORTRAN " , ERR-500) 
C 

REMIND II 
LASTRC-0 
THISRC-1 
NEXTRC-2 

210 READ<1 1/809/ END-220> NC/ <LINE<J>/ J-1/NC> 

IF<NC.GT.e> GO TO 215 
NC-1 

LINE<1>-" " 

215 CONTINUE 

CALL RECHGR<1/7HISRC/LASTRC/NEXTRC/NC/LINE/ IERR/KBUFF,SEUFF> 
IF<IERR.NE.O> GO TO 91008 
LASTRC-LASTRC+1 
THISRC-THISRC+1 
NEXTRC-NEXTRC+1 
GO TO 210 
220 REMIND 11 
CURRLP-1 
NUHREC-LASTRC 
FIRSTR-1 

DO 230 J-NCU-»>1/1S 
230 UFILECJ)-" ' 

HRITE<.LPUNIT/905) <UFILE<J)/ >1/ 15>/NUMREC 
GO TO 800 
C 

C ERROR IN USER FILE 

C 

500 HRITE<LPUNIT/903) <UFILE<J>/ J»l/ 15) 

GO TO 100 


C PROMPT FOR USER COMMAND 

C 

C 

800 WRITE<LPUNIT/911> 

900 WRITE<LPUNIT/904) 

NCLINE-0 
DO 950 J-1/90 

950 CLINE(J)*" ' 

READ < 5 . 604 ) NCL I NE / < CL 1 NE < J > / J- 1 / NCL I NE ) 
ICFLG-0 

CLSI CALL SCCA<ICFLG> 

IF<ICFLG.NE.O) GO TO 960 
CALL PARSE 
I HOLD-0 

ASSIGN 900 TO TRANSe 
ASSIGN 900 TO TRANSr 
ASSIGN 900 TO TRANS6 

GO T0<952/ 951 , 951 / 951 / 951 / 951 / 990, 951 , 951 , 951 , 
1 990,990/990, 951, 990,990)>CTVpE+1 

951 IF<CURRLP.EQ.0) GO TO 9S0 

GO TO <990,955,955,935,955,953,955,935,955, 

1 990 , 990 , 990 , 955 , 9 90 , 990 > , CT YPE 

C 

C INOALID COMMAND 
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952 HRITEaPUNIT,912> 

CO TO 900 

NULLIFIED COHHAHD EXIT 

955 IF<C0UNT.EQ.0> GO TO 900 
GO TO 990 

TOP OF FILE WARNING 
960 NRITE<LPUNITy906> 

GO TO TRANSO^ <900/4140/5100/5200/6001/7040.9700) 

END OF FILE WARNING 

970 WRITE<LPUNIT/907) 

GO TO TRANS7/<900/5100/5200/6001/7040) 

EMPTY FILE WARNING 

980 WWITE<LPUNIT/903) 

GO TO TRAN88/ <900/ 5100/ 5200/ 6001/ 7040) 

COMMAND TYPE - CT’i'PE 

1 « RESET 

2 » SET 

3 > NUMBER 

4 « LIST 

5 » FIND 

6 ■ ADD 

7 - DELETE 

8 - REPLACESTRINC 

9 « EXTRACT 

10 > CLEAR 

11 - STOP 

12 - END 

13 « DELETESTRINC 

14 -LIST EXTRACTION BUFFER 

15 » HELP 

990 GO TO < 1 000 / 2000 / 3000 / 4000 / 5000 / 6000 / 7000 / 8000 / 9000 / 1 0000 / 
1 1 1000/ 12000/ 13000/ 14000/ 15000) /CTYPE 



c 

c 

c 

c 

c 

c 

c 

c 

C SET 

C 

C 

C 

C 

C 

C 

C 

2doo ASSIGN see to transs 
2ese KOUNT«e 

IF<NSTRl.NE.e> GO TO 2800 
IF<ALLUP.OR.ALLDHN> GO TO 2700 
IF < COUNT. LT.O) GO TO 2S00 
C 

C SET FORNARD 

C 

2100 IF<CURRLP.EQ.LASTRC> GO TO 970 

2200 CALL RECHGR<4/CURRLP.K1/K3.NC/L1NE/1ERR.KBUFF.SBUFF> 
CURRLP-K3 
KOUNT-KOUNT+1 

IF <KOUNT.LT. COUNT >G0 TO 2100 
GO TO 2999 
C 

C SET BACKHARD 

C 

2500 COUNT— COUNT 

2600 IF<CURRLP.EQ.FIRSTR> CO TO 960 

CALL RECHGR<4.CURRLP/K1/K3.NC>LINE. lERR/KBUFF. SBUFF) 

CURRLP-Kl 

KOUNT-KOUNT+1 

IF < KOUNT.lt. COUNT) GO TO 2600 
GO TO 2999 
C 

c * OR -♦ 

C 

2700 IF<ALLUP> CURRLP-FIRSTR 
IF<ALLDNN) CURRLP-LASTRC 
GO TO 2999 
C 
C 

C SET ON STRING 

C 

C 

2800 CALL RECMGR < 2 . CURRLP . K 1 / K3 / NC . L I HE / 1 ERR . KBUFF . SBUFF ) 
WORKLP-CURRLP 

IF<ALLUP. OR. COUNT. LT.O) GO TO 2900 
C 
C 

C SET ON STRING FORWARD 

C 

C 

2805 IF <KOUNT.EQ. COUNT. AND. .NOT. ALLDWN) GO TO 2999 
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2310 K«0 

LlNE<NC^l>-0 

2315 K-IFIND<NC/NSTR1>LINE«STRM> 
lF<K.NE.e> GO TO 2850 

IF<H0RKLP.EQ.LR8TRC.RND.K0UNT.EQ.e> GO TO 2998 
IF<WORKLP.EQ.LRSTRC.RND.UOUNT.NE.O) GO TO 2999 
H0RKLP-K3 

CALL RECHGR<2/N0RKLP*K1<K3/NC«L1NE^ IERR.KBUFF/S8UFF> 
GO TO 2810 
2850 CURRLP-MORKLP 
KOUNT-KOUNT+l 

1F<H0RKLP.EQ.LRSTRC> GO TO 2999 
H0RKLP*K3 

CALL RECMGR<2/H0RKLP/K1/K3<NC/LINE> IERR/KBUFF.SBUFF> 
GO TO 2805 
C 
C 

C SET ON STRING BRCKHRRD 

C 

C 

2900 COUNT>-COUNT 

2910 IF (KOUNT.EQ. COUNT. RND. .NOT. RLLUP) GO TO 2999 
2920 K-0 

LINE<NC4>l>-0 

2930 K«IFIND<NC/NSTR1/LINE<STRM> 

IF<K.NE.O> GO TO 2950 

IF<l'(ORKLP.EQ.FIRSTR.RND.KOUNT.EQ.O> GO TO 2998 
IF<HORKLP.EQ.FIRSTR.AND.i<OUNT.NE.0> GO TO 2999 
NORKLP-Kl 

C«LL RECHGR<2/H0RKLP/K1/K3/NC,LINE. IERR.KBUFc*SBUFF> 
GO TO 2920 
2950 CURRLP-HORKLP 
KOUNT-KOUNT+l 

IF<WORKLP.EQ.FIRSTR> GO TO 2999 
HORKLP-Kl 

CALL RECHGR ( 2 . HORKLP ,K1,K3.NC/LIHE>IERR. KBUFF , SBUFF > 
GO TO 2910 
C 
C 
C 

c 

c 

2998 IFCIHOLD.EQ.O) HRITE<LPUNIT,922) <STRKJ)/ J«1/NSTR1> 
COUNT-0 

GO TO TRRNSS. <900.5100/6001.7020) 

C 

c 

c 

c 

c 

2999 IF<HSTR 1 . NE . 0 . IWD . < COUNT . NE . 1 . OR . fiLLUP . OR . OLLDNN) ) 

1 WRITE<LPUNIT.924) KOUNT 

COUNT- 1 
fiLLUP-.FRLSE. 

ALLDWH-.FRLSE. 

GO TO TRRNSS. <900.5100.6001.7020) 

C 
C 
C 
C 
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NUMBER 


KOUNT-1 
NORKLF-CURRLP 
IF<NSTRl.NE.e> GO TO 3900 
IF<RLLUP> GO TO 3300 


nOO :r<HORKLP.EQ.LASTRC> GO TO 3200 

CALL RECHGR<4/H0RKLP/K1.K3/NC/LINE/ lERR^KBUFF/SBUFF) 

H0RKLP-K3 

K0UHT-K0UNT4>1 

GO TO 3100 

S200 HRlTE<LPU^aT.909> KOUNT 
GO TO 900 

3300 1F<H0RKLP.EQ.FIRSTR> GO TO 3400 

CALL RECHGR<4/H0RKLP>K1/K3.NC.LINE/ lERP^KBUFF.SBUFF) 

NORKLP-Kl 

KOUNT-KOUNT+1 

GO TO 3300 

3400 HRITE<LPUNIT,923> KOUNT 
GO TO 900 


COUNT OCCURANCES OF LINES HITH A GIUEN STRING 


KOUNT>0 

CALL RECMGR<2/N0RKLP/K1.K3/NC^LINE/ lERR/KGUFF. SBUFF> 
KFOUND-0 

IF<ALLUP> GO TO 3700 


COUNT FORHARD 


3605 K>0 

LlNE<NC+l)-0 

361 5 K« I F I ND < NC . NSTR I , L INE . 3TR 1 . KFOUND-r 1 > 
lF<K.NE.e> GO TO 3650 

3620 IF*.NORKLP,EQ.LASTRC.AND.KOUNT.EQ.0> GO TO 3998 
IF <WORKLP.EQ.LASTRC. AND. KOUNT. NE.0> GO TO 3999 
H0RKLF'*K3 

CALL RECMGR<2.H0RKLP.K1/K3,NC,LINE/ lERR.KBUFF, SBUFF> 
KFOUND-0 

GO TO 3605 
3650 K0UNT»K0UNT+1 
KF0UND»k+NSTRl 
K*0 

IF<KFOUND.GE.NC> GO TO 3620 
GO TO 3615 


C 

C 
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C COUHT 6(%KHARD 

C 

C 

3700 K-0 

LlHE<NC-t>l>>0 

3715 K-IFlND<NC/NSTRl/LIHE>STRl/KFOUNO-t>l> 

IF(K.NE.O) GO TO 3750 

3720 IF<HORKLP.EQ.FIRSTR.RND.KOUNT.EQ.O> GO TO 3998 
IF<HORKLP.EQ.FIR8TR.«ND.KOUHT.NE.O) GO TO 3999 
HORKLP-Kl 

CALL RECNGR<2/H0RKLP.K1/K3>NC.LINE; lERR/KBUFF/SBUFF) 
KF0UND>0 
GO TO 3700 
3750 KOUNT-KOUNT+1 
KFOUND-K+NSTRl 
K-0 

ZF<KFOUND.GE.NC> GO TO 3720 
GO TO 3715 
C 
C 
C 

3998 WRITE<LPUNIT/913) (STRKJ), J-1,NSTR1) 

GO TO 900 

C 

C 

C 

3999 HRITE<LPUNIT.920> KOUNT 
GO TO 900 

C 

C 

C 

C 

C 

C 

C 

C LIST 

C 
C 
C 

c 

c 

c 

c 

4000 flSS’l'N 900 TO TRfiNSL 
4010 WORKLP-CURRLP 

IF<NSTR1.NE.0> GO TO 430O 
KOUNT- 1 

IF<flLLUP> GO TO 4200 
IF<COUNT.LT.O) GO TO 410O 
C 

C LIST FORWARD 

C • 

CALL RECHGR<2.W0R-KLP,K1,K3.NC/LINE. IERR.KBUFF,SE.UFF> 
WRITE<LPUNIT,806>aiNE<J>/J-l.NC) 

4020 IF<HORKLP.EQ.LASTRC) GO TO 970 

I F<. NOT. ALLDWN. AND. KOUNT. EQ. COUNT) GO TO TRANSL. <9O0>5200> 
W0RKLP-K3 

CALL RECHGR<2>W0RKLP.K1,K3.NC.LINE. lERRA'BUFF.SBUFF) 

HR I TE < LPUN I T > 306 X L I NE ( J ) , J= 1 AC > 

KOUNT-KOUNT+1 


GO TO 4020 
C 

C LIST 6ACKHARD 

C 

4100 CALL RECHCR<4.H0RKLP/K1«K3/NC.LINE>IERR.KBUFF/SBUFF> 
COUNT— COUNT 
ASSIGN 4140 1 TRANSS 
4120 IF<NORKLF.EQ.MRSTR> GO TO 900 
IF<KOUNT. EG. COUNT) GO TO 4140 
NORKLF-Kl 

CALL RECNGR<4/N0RKLF/K1.K3/NC/LINE. lERR.KBUFF.SBUFF) 

KOUNT-KOUNT-M 

GO TO 4120 

4140 CALL RECNGR<2>H0RKLP.K1,K3«NC.LINE/IERR/KBUFF/SBUFF) 
NinTE<LPUNIT«800> <L1NE<J).>1«NC) 
IF<HORKLP.EG.CURRLP) GO TO TRANSL. <900.5200) 
H0RKLP>K3 
GO TO 4140 
C 

C H« 

C 

4200 NORKLP-FIRSTR 
GO TO 4140 
C 
C 

C LIST ON STRING 

C 

C 

4300 K0UNT«0 

CALL RECHGR<2.H0RKLF.K1.K3.NC>LINE. lERR.KBUFF.SBUFF) 
IF<ALLUP. UR. COUNT. LT.O) GO TO 4600 
4310 IF<KOUNT. EG. COUNT. AND. .NOT. ALLDWN) GO TO 4900 
4350 K«e 

LINE<NC-<-l>>0 

K»IFIND<NC,KVR1.LINE.STR1.1> 

IF<K.NE.O) GO TO 4400 

1F<N0RKLP.EG.LASTRC.AND.K0UNT.EQ.0) GO TO 4000 
IF<HORKLP.EQ.LASTRC.AND.KOUNT.NE.O) GO TO 4900 
N0RKLP*K3 

CALL RECHGR<2. WORKLP . K1 . K3. NC. LINE. lERR. KBUFF. SBUFF) 
GO TO 4350 

4400 HRITE<LPUNIT.806) <LINE<J). J»1 ,NC> 

K0UNT»K0UNT+1 

IF<WORKLP.EQ.LASTRC) CO TO 49O0 
WORKLP *K3 

CALL REC^ GR<2. WORKLP. kl . K3. NC. LINE. lERR. KBUFF. SBUFF) 
GO TO 4310 
C 
C 

C LIST ON STRING BACKWARD 

C 

c 

4600 COUNT=-COUNT 

4610 IF<KOUNT. EG. COUNT. AND. .NOT. ALLUP) GO TO 4750 
4650 K^^O 

LINE<NC+1>«0 

K»IFIND<NC.NSTR1.LINE.STR1.1> 

IF<K.NE.O) GO TO 4700 

IF< WORKLP. EQ.FIRSTR. AND. KOUNT.EQ.0) GO TO 4S0O 
IF<WORKLP.EQ.FIRSTR.AND.KOUNT.NE.0) GO TO 4750 
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HORKLP*Kl 

CRLL RECMGR(2/W0RKLP/K1<K3>HC/L1NE/ IERR<KBUFF/SBUFF> 
00 TO 4650 
4700 IHOLD-HORKLP 
KOUNT-KOUNT+1 

1F<H0RKLP.EQ.FIRSTR> 00 TO 4750 
HORKLP-Kl 

CRLL RECH0R<2/H0RKLP«K1.K3/NC.LINE/ IERR>K6UFF/36UFF> 
00 TO 4610 
4750 WORKLP-IHOLD 

4760 CRLL RECHGR<2.H0RKLP»ia>K3iNC.LINE. lERR/KBUFF/SBUFF) 
K-0 

LINE<NC-t>l>-0 

K-IFIND<NC/NSTR1/L1NE>STR1.1> 

1F<K.NE,0> HRITEaPUNlT«806> (LINE<J>. >1.NC> 
IF<H0RKLP.EQ.CURRLP> 00 TO 4900 
H0RKLP-K3 
GO TO 4760 


4800 WRITE<LPUNIT/913) <STRKJ), J-l,NSTRl) 
)30 TO TRRNSL/ <900. 5200) 


HRITEsLPUNIT/924) KOUNT 
GO TO TRRNSL. <900. 5200) 


FIND 


5000 ASSIGN 5100 TO TRANSS 
ASSIGN 5100 TO TRANS6 
ASSIGN 5100 TO TRANS7 
ASSIGN 5100 TO TRANS8 
GO TO 2050 

5100 IF<COUNT.EQ.0> GO TO 52O0 
COUNT* 1 
NSTR1»0 

ASSIGN 5200 TO TRANSL 
ASSIGN 5200 TO TRANS6 
ASSIGN 5200 TO TRANS? 
ASSIGN 5200 TO TRANS8 
GO TO 4010 

5200 ASSIGN 900 TO TRANSS 
ASSIGN 900 TO TRANSL 
ASSIGN 900 TO TRANS6 
ASSIGN 900 TO TRANS7 
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ASSIGN sea TO TRi:t(^S8 
GO TO 900 


ADD 


6000 ASSIGN 900 TO TRANSA 
IF<NSTR1.EQ.0> GO TO 6004 
IHOLD-CURRLP 

IF<ALLUP. OR. COUNT. LT.O) lAC—l 
IF<ALLDNN. OR. COUNT. CT.O) IAC>1 
ASSIGN 6001 TO TRANS3 
ASSIGN 6001 TO TRANS6 
ASSIGN 6001 TO TRANS7 
ASSIGN 6001 TO TRANS8 
GO TO 2050 

6001 IF<COUNT.EQ.O) GO TO 6003 
COUNT»IAC 

NSTRl-0 
ALLUP>. FALSE. 

ALLDNNa. FALSE. 

ASSIGN 6003 TO TRANSA 
GO TO 6004 

6003 ASSIGN 900 TO TRANSA 
ASSIGN 900 TO TRANSS 
ASSIGN 900 TO TRANSS 
ASSIGN 900 TO TRANS7 
ASSIGN 900 TO TRANSS 
CURRLP*IHOLD 

GO TO 900 

6004 IF<.N0T.B4USED> REWIND 4 
WRITE<LPUNIT/910) 

WRITE<LPUNIT;914> 

READ<5.8O5.END=6040> NC. <LINE<J>. J=l,NC> 
ICFLG*0 

as I CALL SCCA<ICFl.G> 

IF<ICFLG.NE.O> GO TO TRANSA. <900.6003 > 
IF<NC.EQ.0> GO TO 6040 


6005 


IF<LINE<1>.EQ.'#0 GO TO 603O 
IADEL>LINE<1> 

IF<NC.GT.l) GO TO 6005 
LINE<1>=" ' 

GO TO 6008 
NC=HC-1 


DO 6006 J=1.NC 
6006 LINE<J>=LINE<J+i:' 

IF<LINE<HC>.NE.IADEL> GO TO 6008 
NC=NC-'l 

IF<NC.GT.0) GO TO 6007 
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NC>1 

LINE<1)*' ' 

6007 REHIND 4 

B4USED-. FALSE. 

HRITE<4/END-67eO> NC/ <L1NE<J>> J-l.NC) 

GO TO 6020 
C 

C READ TEXT FROM TERHINAL 

C 

6000 REHIND 4 

B4USED-. FALSE. 

6010 NRITE<4/END-6700> NC/ '(LINE<J>/ J>1.NC> 
NRITE<LPUNIT.914) 

READ<5>805.END>6020> NC/ <LINE<J>> J-l/NC 
ICFLG-0 

CLSI CALL SCCA<ICFLG> 

IFdCFLG.NE.O) GO TO TRANSA. <900.6003 > 
IF<NC.EQ.O> GO TO 6020 
IF<LINE<NC>.EQ.IADEL> GO TO 6015 
GO TO 6010 

6015 IFv'NC.EQ.l) GO TO 6017 
NC»NC-1 

HRITE<4.END«6700> NC. <LINE<J.' . J-l.NC) 

GO TO 6020 
6017 LINE<1>»' " 

NR I TE< 4. END-6700 > NC. <LINE<J>. J-l.NC) 

GO TO 6020 
C 

C ADD TYPED IN TEXT 

C 

6020 I TEXT-4 
ENDFILE 4 
B4USED-.TRUE. 

GO TO 6100 
C 

C ADD TEXT FROM THE EXTRACTION BUFFER 

C 

6030 I TEXT-3 

IF<.N0T.B3USED> GO TO 6800 
64U3ED-. FALSE. 

GO TO 6100 
C 

C ADD THE SANE TEXT USED LAST TIME 

C 

6040 IF<ALAST.EQ.e> GO TO 6800 
ITEXT-ALAST 
C 

C ADD INDICATED TEXT 

C ITEXT-3 IF FROM EXTRACTION BUFFER 

C =4 IF FROM TYPE-IN 

C 

6100 REMIND ITEXT 
ALAST-ITEXT 
KOUNT-O 

IF<CURRLP.EQ.O) GO TO 6200 
HORKLP-CURRLP 
IF<ALLUP> GO TO 6600 
IF<ALLDWN> GO TO 6400 
IF«.COUNT.LE.0>GO TO 6500 
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C COUNT IS FOSITIUE 

C 

IF<HORKLP.EQ.LNSTRC>GO TO S400 
KNT>e 

S150 CALL RECHCR<4.H0RKLP/K1.K3/NC/L1NE/IERR.KBUFF/3BUFF> 
KNT-KNT+l 

IF<COUNT.EQ.KNT> GO TO 6300 
N0RKLP>K3 

IF<NORKLP.£Q.LASTRC> GO TO 6400 
GO TO 6150 
C 

C ADO TO EMPTY FILE 

C 

6200 KLA3T-0 
KTHIS-1 
KNEXT-2 

6210 READ<ITEXT/ END-6220) NC/ <LINE<J). J-l.NC) 

CALL RECHGR<1/KTHI3.KLAST/KNEXT/NC/LINE> IERR>KBUFF>3BUFF) 
IF<1ERR.NE.0> GO TO 91000 
KLAST-KTHI3 
KTHI3-KNEXT 
KNEXT-KNEXT+1 
KOUNT-KLAST 
GO TO 6210 
6220 LA3TRC-KLAST 
NUHREC-KOUNT 
FIR3TR-1 
CURRLP-1 
GO TO 6900 
C 

C ADD TO EXI3TING FILE BETWEEN EX13TINC RECORDS 

C 

6300 CALL RECHGR<4/N0RKLP.K1>K3/NC.LINE/IERR^KBUFF.3BUFF) 

CALL RECHGR<4«K3«K4/K6.NC2^LINE2/ 1LRR> KBUFF. SBUFF) 

KHOLD— K3 

CALL RECHGR<3>N0RKLP>K1<NUHREC*1>NC.LINE. lERR^KBUFF.SBUFF) 

KLAST-NORKLP 

KTHIS-NUMREC+1 

KNEXT-NUMREC-«-2 

6310 READ<ITEXT/END=6320> NC/ <LINE<J>/ J=1 .NO 

CALL RECMGR<1.KTHIS.KLAST/KNEXT.NC.LINE. lERR.KBUFF.SBUFF) 

KOUNT-KOUNT+1 

KLAST-KTHIS 

KTHIS-KNEXT 

KNEXT-KNEXT+1 

GO TO 6310 

6320 CALL RECMGR < 4 . KLAST . K4 . K6 . NC . L I NE . I ERR . KBUFF . SBUFF ) 

CALL RECMGR < 3 . KLAST . K4 , KHOLD . HC . L I NE . I ERR . KBUFF .SBUFF ) 

CALL RECMGR < 4 . KHOLD . K4 . K6 . NC . L I NE . I ERR . KBUFF . SBUFF > 

CALL RECMGR<3.KH0LD. KLAST, K6.NC. LINE. lERR.KBUFP, SBUFF) 
NUMREC-NUHREC+KOUNT 
GO TO 6900 
C 

C ADD TO END OF EXISTING FILE 

C 

6400 CALL RECMGR < 4. LASTRC.K1.K3.NC. LINE. I ERR, KBUFF. SBUFF) 

CALL RECMGR < 3 . LASTRC . K 1 . NUMREC+ 1 . NC . L I NE , I ERR , KBUFF , SBUFF ) 

KLAST-LASTRC 

KTHIS-NUMREC+1 

KNEXT-NUMREC+2 


150 


o o oo o o o o o o o ^ ^ o o o 


6410 READ<ITEXT.END«6420> NCaLINE<J>/ J- l/NC^ 

CALL RECHCR< 1 ^ KTHIS/ KLAST. KNEXT. NC. LINE/ lERR/ KBUFF/ SBUFF) 
1F<IERR.NE.0> GO TO 91008 
KOUNT-KOUNT+1 
KLAST-KTHIS 
KTHIS-KNEXT 
KNEXT-KNEXT+l 
GO TO 6410 
6420 LASTRC-KLAST 

NUHREC>NUMREC-»>KOUNT 
GO TO 6900 

COUNT IS NEGATIUE 

IF<NORKLP.EQ.FIRSTR> GO TO 6600 
KNT-0 

COUNT— COUNT 

CALL RECMGR<4/H0«=‘KLP/K1/K3/NC/LINE/ lERR/KBUFF/ SBUFF) 
KNT-KNT+1 
N0RKLP*K1 

IF<COUNT.EQ.KNT) GO TO 6300 
IF<HORKLP.EQ.FIRSTR) GO TO 6600 
GO TO 6550 

ADD TO TOP OF FILE 


S600 KLAST«0 

KTHIS«NUHREC+1 

KNEXT»NUMREC+2 

6610 READ<ITEXT/END«6620) NC/ <LINE<J)/ J-l/NC) 

CALL RECHGR< 1 / KTHIS/ KLAST/ KNEXT/ NC/ LINE/ lERR/ KBUFF/ SBUFF) 

KOUNT-KOUNT+1 

KLAST-KTHIS 

KTHIS-KNEXT 

KNEXT-KNEXT+l 

GO TO 6610 

6620 CALL RECHGR<4/ KLA3T/K1/K3/NC/ LINE/ lERR/ KBUFF/ SBUFF) 

CALL RECHGR<3/KLAST/K1/FIRSTR/NC/LINE/ lERR/ KBUFF/ SBUFF) 
CALL RECMGR<4/FIRSTR/K1/K3/NC/LINE/ lERR/ KBUFF/ SBUFF) 

CALL RECHGR<3/FIRSTR/KLAST/K3/NC/LIHE/ I ERR /KBUFF /SBUFF) 

FIRSTR-NUHREC+1 

NUMREC-NUMREC+KOUNT 

GO TO 6900 

END OF FILE HHILE WRITING UNIT 4 

6700 WRITE<LPUNIT/918) 

GO TO 6020 

NO TEXT ENTERED 

6800 WRITE<LPUNIT/916) 

GO TO TRANSA/ (900/6003) 


6900 WRITE(LPUNIT/915) 

GO TO TRANSA/ (900/6003) 
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DELETE 


7000 ASSIGN 900 TO TRANSD 
DALLUP-. FALSE. 

DALLDN-. FALSE. 

IHOLD«0 

1F<NSTR1.EQ.0> GO TO 7049 

DELETE SELECTED STRINGS 

IHOLD-CURRLP 

IDCNT1«IABS<C0UNT> 

IDCNT2-C0UNT 
IFCALLUP) DALLUP-.TRUE. 

IFXALLDNN) DALLDN*. TRUE. 

ALLUP>. FALSE. 

ALLDHN>. FALSE. 

ASSIGN 7040 TO TRANS6 
ASSIGN 7040 TO TRANS7 
ASSIGN 7040 TO TRANS8 
IDCNT3*0 
IDKl-0 

7010 ASSIGN 7020 TO TRANSS 

IF < DALLUP . OR . IDCNT2 . GT . 0 ) COUNT— 1 
IF <DALLDN. OR. IDCNT2.lt. 0) COUNT* 1 
GO TO 2050 

7020 IF < COUNT. EQ.0> GO TO 7040 

IFCDALLUP . OR . IDCNT2 . GT . 0> C0UNT»-1 
I F < DALLDN . OR . I DCNT2 . LT . 0) COUNT* 1 
ASSIGN 7030 TO TRANSD 
GO TO 7049 
7030 IDCNT3»IDCNT3+l 
IDKl*IDKl+l 

IF<DALLUP. OR. DALLDN. OR. IDKl.LT.IDCNTl) GO TO 7O10 
7040 NRITE<LPUNIT,925> IDCNT3 
DALLUP*. FALSE. 

DALLDN*. FALSE. 

IF<IHOLD.NE.0) CURRLP*IHOLD 
ASSIGN 900 TO TRANSS 
ASSIGN 900 TO TRANSD 
ASSIGN 900 TO TRAN,'v6 
ASSIGN 900 TO TRANS7 
ASSIGN 900 TO TRANSS 
GO TO 900 


DELETE OPERATIONS 


152 


ooooo ooooo o o o oooooo ono ooonn 


7045 CrtLL RECHGR'.4/CURRLP>Ki,K3.NC>LINE/IERR>KBUFF,S6UFF> 
IF<CURRLF.EQ.LASTRC> GO TO 7300 
IF<CURRLP.EQ.FIRSTR) GO TO 705© 

60 TO 7600 


OT TOP OF FILE 


IF<RLLDNN> GO TO 7210 

IF<«LLUP. OR. COUNT. LT.O) GO TO 7200 

COUNT IS POSITIUE. DELETE TONRRDS END OF FILE 


7100 


DO 7100 >1. COUNT 

IF<CURRLP.EQ.LRSTRC> GO TO 7210 

IF < IHOLD . NE . 0 . RND . IHOLD . EQ . CURRLP) IH0LD-K3 

CURRLP-K3 

FIRSTR-K3 

CNLL RECHGR<4/CURRLP>K1.K3.NC>LINE/ lERR.KBUFF.SE'UFF) 
CONTINUE 

GO TO TRRNSD. <900. 7030) 


COUNT IS NEGflTIUE. DELETE FIRST RECORD IN FILE 


7200 


IF<CURRLP.NE.LfiSTRC) CO TO 7250 


ONLY ONE RECORD IN FILE. CLEAR FILE 


'210 CURRLP«0 
NUMREC»0 
LASTRC*0 
FIRSTR«0 
IHOLD«e 

CALL RECHGR<0.0.K1.K3.K4.K5. lERR.KBUFF. SBUFF) 
GO TO 980 


SEUERAL RECORDS IN FILE. RESET FIRST RECORD 

7250 IF< IHOLD . NE . 0 . AND . IHOLD . EQ . CURRLP) IH0LD=K3 
CURRLP=K3 
FIRSTR=k3 

GO TO TRANSD. <900. 7030) 


AT BOTTOM OF FILE 


7300 IF<ALLUP> GO TO 7210 

IF<COUNT.LT.0> GO TO 740O 


COUNT IS POSITIUE. DELETE LAST RECORD 


IF<CURRLP.EQ.FIRSTR> GO TO 7210 

CURRLP »K1 

LASTRC=CURRLP 

GO TO TRANSD. <900. 7030) 


t 


C COUMT IS KEGATiyE, DELETE TOP OF FILE 

C 

7400 COUNT— COUNT 

DO 7500 >1. COUNT 

1F<CURRLP.EQ. FIRSTR) GO TO 7210 

IF < IHOLD . NE . 0 . RND . IHOLD . EQ . CURRLP > IHOLD-K 1 

CURRLP-Kl 

LflSTRC*Kl 

7500 CRLL RECHGR<4.CURRLP>K1<K3>NC/LINE.IERR.KEUFF/S6UFF> 

GO TO TRRNSO.<900>7030> 

C 

C 

C IN THE MIDDLE OF THE FILE 

C 

C 

7600 IF(RLLDHN> GO TO 7750 
IF<flLLUP) GO TO 7950 
IF<COUNT.LT.O) GO TO 7800 
C 

C COUNT IS POSITIUE/ DELETE FORHRRD 

C 

KLHST>K1 

DO 7700 >1, COUNT 
IF<CURRLP.NE.LRSTRC> GO TO 7650 
C 

C READJUST END OF FILE 

C 

IF < IHOLD . NE . 0 . AND . IHOLD . EQ . CURRLP) IHOLD-KLAST 

CURRLP-KLAST 

LASTRC-KLAST 

GO TO 970 

7650 IF < I HOLD. NE.O. AND. IHOLD. EQ. CURRLP) IH0LD-K3 
CURRLP *K3 

7700 CALL RECMGRU.CURRLP.K1.K3/NC.LINE.IERR.KBUFF,S6UFF) 

C 

C READJUST LINKS AROUND DELETED RECORDS 

C 

7710 CALL RECMGR<3.CURRLP,KLAST,K3/NC.LINE.IERR/KBUFF,SBUFF) 
CALL RECMGR<4,KLAST,Kl,K3,NC/LINE, IERR/KBUFF,SBUFF) 

CALL RECMGR<3,KLAST,K1>CURRLP,NC,LINE. IERR,KBUFF,SBUFF) 
GO TO TRANSD/ <900. 7030) 

C 

C ALLDHN 

C 

7750 CURRLP-Kl 
LASTRC*K1 

GO TO TRANSD. <900. 7030) 

C 

C COUNT IS NEGATIUE. DELETE BACKHARD 

C 

^800 COUNT»-COUNT 
KNEXT=K3 

DO 7900 J»l. COUNT 
IF < CURRLP. NE. FIRSTR) GO TO 7850 
C 

C READJUST TOP OF FILE 

C 

I F < I HOLD . NE . 0 . AND . I HOLD . EQ . CURRLP ) I HOLD=KNEXT 

CURRLP=KNEXT 

FIRSTR=KNEXT 
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CO TO 960 

7850 IF(IHOLD.NE.O.AND.ZHOLD.EQ.CURRLP) IHOLD-Kl 
CURRLP-Kl 

7900 CALL RECMGR<4/CURRLP«K1#K3«NC/L1N£.IERR/KBUFF/S6UPF> 

READJUST LINKS AROUND DELETED RECORDS 

7910 CALL RECHCR<3/CURRLP^K1^KNEXT.NC/LINE/IERR/K6UFF/S6UFF> 
CALL RECHGR < 4 ; KNEXT . K 1 / K3 . NC « L I NE / 1 ERR « KBUFF > 3BUFF > 

CALL RECHGR < 3 / KNEXT . CURRLP / K3 / NC < L I NE ^ lERR / KBUFF / SBUFF > 
GO TO TRANSD> <900/ 7030) 

ALLUP 

7950 CURRLP-K3 

GO TO TRANSD/ <900/ 7030) 


REPLACE STRING 


6000 CALL RECHGR<2/ CURRLP/ K1/K3/NC/ LINE/ lERR/ KBUFF/ SBUFF) 
WORKLP-CURRLP 
KFOUND-e 
KOUNT-0 

IF< ALLUP. OR. COUNT. LT.O) GO TO 8600 
6010 IF<K0UNT. EQ. COUNT. AND. .NOT. ALLDHN) GO TO 8900 
3050 K>e 

LlNE<NC+l)-0 

K« I F I ND < NC / NSTR 1 / L I NE / STR 1 / KFOUND+ 1 ) 

IF<K.NE.0> GO TO 8200 

IF<NORKLP.EQ.LASTRC.AND.KOUNT.EQ.O) CO TO 8100 
IF<HORKLP.EQ.LASTRC.AND.KOUHT.NE.O> GO TO 8900 
N0RKLP*K3 

CALL RECMGR<2/W0RKLP/K1/K3/NC/LINE/ I ERR /KBUFF /SBUFF) 

KFOUND-0 

GO TO 8050 

STRING NOT FOUND 

8100 WRITE<LPUNIT/913) <STRKJ)/J«l/NSTR1) 

GO TO 900 


INSERT STRING 


8200 Kl>e 
K2«K-1 

IFCK.EQ.l) GO TO 8300 
DO 8250 J=l/K2 
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Ki-ki+1 

82S0 LINE2<KI>«L1M£<J> 

63190 1F<NSTR2.EQ.0> GO TO 8359 
DO 6350 J-1/NSTR2 

8350 LINE2<KI>«STR2<J> 

8355 1F<NC.EQ.<K2^NSTR1>> GO TO 8400 
K2-K4NSTR1 
DO 8360 >K2^NC 
KI-KI+1 

6360 L1NE2<K1>«L1NE<J> 

8400 NC-KI 

IF<NC.GT,e> GO TO 8410 
NC*1 

LINE2<1)-' ' 

8410 DO 8450 J-l.NC 
8450 LINE<J>-LINE2<J> 

CALL RECHGR<1.H0RKLP/K1>K3.NC/LINE2. IERR.KBUFF.S6UFF> 

KOUNT-KOUNT^l 

KF0UND«K-i>NSTR2 

GO TO 8010 


TOWflRDC ’")P OF FILE 


8600 COUNT— COUNT , 

8610 IF<K0UNT. EQ. COUNT. AND. .NOT. RLLUP) G0 TO 3900 i 

8650 K-0 

LINE<NC-»>l>-0 

K-IF1ND<NC/ NSTRl / LINE> STRl . KFOUND-*-! > 

IF<K.NE.O> G0 TO 8600 

1F<H0RKLP.EQ.FIRSTR.AND.K0UNT.EQ.0> GO TO 6100 
• IF<HORKLP.EQ.FIRSTR.fiND.KOUNT.NE.O> GO TO 3980 
NORKLP*K 1 

CALL RECHGR<2/ NORKLP. K1 / K3/ NC. LINE/ lERR/ L&UPF/ 3BUFF) 

KFOUND-0 
GO TO 8650 


INSERT STRING 



8800 K1«0 
K2-K-1 

IF<K.EQ.1> GO TO 8860 
DO 8850 >1/K2 
KI-KI+1 

8850 LINE2<KI>-LiNE<J> 

8860 IF<NSTR2.EQ.0> GO TO 8955 
DO 8950 J-1/NSTR2 
KI-KI+1 

8950 LINE2<KI>STR2<J> 

8955 IF<NC.EQ.<K2+NSTR1>) GO TO 8970 
K2-K+NSTR1 
DO 8960 J-K2/NC 
KI-KI+1 

8960 LINE2<KI>-LIN£(J> 

8970 NC-KI 

IF<NC.GT.O) GO TO 8975 
NC-1 

LINE2<1>-' ' 
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89?5 DO 6980 J-l.NC 
8980 LlNEvJ»UNE2<J> 

C()LL RECHGR< 1 . HORKLF/ K1 . K3^ NC< LINE2/ lERR. KEUFF. S6UFF> 

K0UNT-K0UNT*1 

KF0UND-K4NSTR2 

GO TO 8610 


8900 NR1TE<LPUN1T«920> KOUNT 
CO TO 900 


EXTRACT 


IF<COUNT.EQ.O) GO TO 900 
B3USED-.TRUE. 

HORKLP-CURRLP 
KOUNT- 1 

IF<ALLUP> GO TO 9900 
IFCCOUNT.LT.O) GO TO 950O 

EXTRACT FORHARD 

CALL RECHCR<2«N0RKLP>K1.K3>NC>LIN£. lERR.KBUFF/SBUFF) 
NRITE<3.ENO-93O0> NC/ CLINE<J>. J-1 .NC) 
IF<WORKLP.EQ.LASTRC) GO TO 970 
IFC.NOT.ALLDHN.AND. COUNT. EQ. KOUNT) GO TO 900 
W0RKLP-K3 

CALL RECMGR<2,W0RKLP/K1,K3*NC.LINE. IERR,KBUFF,SEUFF) 
HR 1 TE < 3 < END-9800 > NC / < L I HE < J > « J- 1 < NC ) 

KOUNT-KOUNT+1 
GO TO 9100 

EXTRACT BEFORE POINTER 

9500 COUNT— COUNT 

ASSIGN 9700 TO TRANSe 

CALL RECMGR<4,H0RKLP.K1*K3,NC.LINE. IERR.KBUFF,SBUFF) 
9600 IF<HORKLP.EQ.FIRSTR> GO TO 960 
IF<KOUNT.EQ. COUNT) GO TO 9700 
NORKLP— K1 

CALL RECHGR(4,H0RKLP.K1/K3,NC.LINE/ lERRA'BUFF.SBUFF) 

KOUNT-KOUNT+1 

GO TO 9600 

9700 CALL RECHGR < 2 . NORKLP A 1 A3 , NC / L I NE . I ERR ABUFr . SBuFF ) 
HR I TE < 3 , END- 9800 ) NC A L I NE < J ) , J* 1 , NC ) 

NORKLP— K3 

IF<NORKLP.EQ.CURRLP) GO TO 9O0 

157 


GO TO 9700 


C 

C 

C 


END OF FILE HHILE HFITING UNIT 3 


9600 NR1TE<LPUNIT.917> 
GO TO 900 


C 

C * 

C 

9900 NORKL*' IRSTR 
GO TO V ' 

C 

C 

C 

C 

C 

c 

c 

C CLEAR 

c 

c 

c 

c 

c 

c 

c 

10000 REMIND 3 

63USED-, FALSE. 
GO TO 900 
C 

c 

c 

c 

c 

c 

c 

C STOP 

c 

c 

c 

c 

c 

c 

c 

11000 CL0SE<UNIT>1> 
CLOSE < UNIT-2) 
CLOSE < UN IT-3) 
CLOSE < UN IT-4) 
CLOSE<UNIT»ll) 
CALL EXIT 
C 

c 

C 

c 

c 

c 

c 

C END 

c 

c 
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I 

I 


1 


I 






1 



c 

c 

c 

c 

c 

i2eee rewind n 

KOUNT-e 

IF<NEWFIL> GO TO 12001 
asi CLOSE<UNIT-11/DISPOSE>^DELETEO 

CUflX CL0SE<UNIT-11 /DISPOSE- 'KEEP O 

UFILE<NCU-^l>-0 

0PEN<UNIT-1 1/NNHE-UFILE/ TYPE-'NEN' / ACCESS- 'SEQUENT I AL ' / 

1 FORM-'FORMATTED' / DISPC?r-'k£EP' > CARR I AGECONTROL-' FORTRAN' » 

2 ERR-12999) 

12001 REWIND 11 

CURRLP-F IRSTR 

12050 CALL RECMCR<2iCURRLP/Kl/K3/NC/LINE/IERR/KBUFF/SBUFF) 

K-0 

DO 12100 J-NC/1/-1 
K-J 

IF<L1NE<J>.NE.' ') GO TO 12200 
12100 CONTINUE 
K-1 

12200 NRlTEai/e07XLINE<J>/J-l/K> 

KOUNT-KOUNT+1 

K2-CURRLP 

nippi 

IF<K2.NE.LASfRC> GO TO 12050 
DO 12210 J-NCU-t-l/lB 
12210 UFILE<J)-' ' 

WRITE aPUNIT/905> <UFILE<J)/ J-1/ 15XK0UNT 
GO TU 11000 
C 
C 
C 
C 
C 
C 
C 

C DELETE STRING 

C 

C 

C 

C 

C 

C 

c 

13000 GO TO sooe 

c 

c 

c 

c 

c 

c 

c 

c 

c LIST EXTRACTION BUFFER 

C 
C 
C 
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c 

c 

c 

c 

c 

14900 IF<.N0T.63USED> GO TO 900 
KOUNT-0 
REHIND 3 

14100 REHD<3^ END-14200) NC. <LINE<J>« J-l/NC) 
HRITE<LPUNIT/806) <LINE<J),>1>NC) 


14200 

14300 

C 

C 

C 

C 

C 

C 

C 

C 

C 

C 

c 

c 

c 

c 

c 

15000 

c 

c 

c 

c 

c 

91000 

C 

C 

c 

c 

c 

c 

c 

c 

c 

c 

801 

802 

803 

804 

805 

806 

807 

808 
901 


KOUNT-KOUNT+1 
60 TO 14100 
REHIND 3 

DO 14300 J-l/KOUNT 
REHD<3> NC 
GO TO 900 


HELP 


WRITE<LPUNIT,921) 
GO TO 900 


HRITEaPUNIT,919) 
GO TO 900 


FORMAT a 5fil) 

FORMAT <fll) 

FORMAT <65A2) 

FORMAT <0..80A1> 

FORMAT <G,135A1) 

F0RMATaX/135Al) 

F0RMATa35Al> 

FORMAT < Q, I 6Ai) 

FORMAT <.'VV'/10X. 'LINE-ORIENTED TEXT EDITOR /I OX. 
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1 'yERSION 3.0'/.'. 10X, FILE ^DEUICEiFILElWME'. 

2 -.TYPE) » ',$> 

902 FORM«T<//10X, 'NEW FILE <V/N> T ',f> 

903 FOPH«T<//'10X, 'ERROR IN OPENING FILEi '/IWi//) 

904 FORHfiK' ? M) 

905 FORM«T</10X, 'FILEi ',15«1,' CONTAINS '.17.' LINES'//) 

906 FORHAK 1 0X. '♦♦♦♦* TOP OF FILE ♦*' ) 

907 FORMAT <1 OX. '♦**♦* END OF FILE ***■■ 

90S FORMAT<10X. EMPTY FILE 

909 FORMATUOX. 'NUMBER OF LINES TO END OF FILE - '.I7> 

910 F0RMAT<2X. 'ENTER TEXTi') 

911 F0RHAT<2X. 'BEGIN TEXT EDITING ) 

912 F0KNAT<2X.'INUALID COMMAND') 

913 FORMAT <2X. 'STRING NOT FOUNDi '.40A1) 

914 FORMAT<' ! '.♦) 

915 F0RMAT<2X.'TEXT ENTERED.') 

916 F0RMAT<2X.'N0 TEXT ENTERED') 

917 FORMAT<//10X. END OF FILE OCCURED DURING WRITING'. 

1 ' EXTRACTION FILE ♦♦•♦♦♦'//16X. 'EXTRACTION FILE PROBABLY'. 

2 ' FULL'//16X. 'RECOMMENDED ACTION ■ CLEAR'///) 

918 FORMAT<//10X. '♦♦♦** END OF FILE OCCURED DURING ADD TEXT'. 

1 ' BUFFER WRITING '//16X. 'ADD WILL BE ATTEMPTED' 

2 /16X'RESULTS MAY NOT INCLUDE LAST LINE TYPED'/) 

919 F0RMAT<2X. ERROR IN HANDLING SCRATCH FILE ♦***♦') 

920 FORMAT (2X. 15. ' OCCURANCES OF PHRASE FOUND') 

921 FORMAT </T5. 'COMMAND STRUCTURE i '//'i 10. 

1 'COMMAND I /STRING ONE/. /STRING TWO/. COUNT //T5. 

2 'COMMANDSi '//Tie. 'RESET - R- M25. 'SET - S'.T40. 

3 'NUMBER - N'.T55.'LIST - L'/TIO. 'FIND - F.T25. 

4 'ADD - A'. T40. 'DELETE - D'.T55. REPLACE STRING - RS'/ 

5 TIO. 'EXTRACT - E'.T25. 'CLEAR'. T40. STOP. T55, 

6 DELETE STRING - DS'/T10. 'HELP' . T25. END'/) 

922 FORMAT <2X. 'LINE WITH STRING NOT FOUNDi '.40A1> 

923 FORMAT<10X. 'NUMBER OF LINES TO TOP OF FILE * '.16) 

924 F0RMAT<2X.I5. ' LINES CONTAINING PHRASE FOUND ) 

925 FORMAT <2X. 15.' LINES WITH STRING DELETED) 

9991 STOP 9991 

9992 STOP 9992 

9993 ST-;^ 9993 

9994 STOP 9994 
12999 STOP 12999 

END 

SUBROUTINE SETLC 

CLSI CALL IPOKE<’’44."400OO.OR.IPEEK<"44>) 

RETURN 

END 

SUBROUTINE PARSE 


THIS PARSES THE COMMAND LINE 


A COMMAND LINE FOR THIS EDITOR NAV BE EXPRESSED BY THE 
FOLLOWING COMPONENTS. OR AN ArPROFRIATE SUBSET; 
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COHNAND I /STRING ONE.- ,/ STRING TNG/. COUNT 

HHERE 

COMMAND - C - IS ONE OF THE FOLLOHING SET OF AN AFFROPRIATE 
ABBREUIATIONi RESET. SET. NUMBER. LIST. FIND. 
ADD. DELETE. RS. EXTRACT. CLEAR. STOP. END. 

I - I > IS A REQUIRED SEPERATOR BETWEEN THE COMMAND 

AND ANY STRINGS. 

/ - D1 - THE CHARACTER DELIMITING THE BEGINNING OF THE 

FIRST STRING. IT MAY BE ANY CHARACTER. BUT 
IS NOT USED AS PART OF THE STRING. 

STRING 

ONE - SI - ANY STRING OF CHARACTERS. EXCEPT THE CHARACTER 
USED FOR Dl. MINIMUM LENGTH - 1. MAXIMUM *30. 

/ - D2 - THE CHARACTER DELIMITING THE END OF THE FIRST 

STRING. IT MUST BE THE SAME AS Dl; IT DOES 
NOT BECOME PART OF THE STRING. 

. - . - IS A REQUIRED SEPARATOR BETWEEN THE FIRST 

STRING SPECIFICATION AND ANY SECOND STRING 
SPECIFICATION. 

/• - D3 - THE character DELIMITING THE BEGINNING OF THE 

SECOND STRING. IT MAY BE ANY CHARACTER. BUT 
IS NOT USED AS PART OF THE STRING. 

STRING 

TWO - S2 - ANY STRING OF CHARACTERS. EXCEPT THE CHARACTER 
USED FOR D3. MINIMUM LENGTH « 1. MAXIMUM « SO. 

/ - D4 - THE CHARACTER DELIMITING THE END OF THE SECOND 

STRING. IT MUST BE THE SAME AS D3. IT DOES 
NOT BECOME PART OF THE STRING. 

; - ; - IS A REQUIRED SEPARATOR BETWEEN THE COMMAND. 

WITH OR WITHOUT STRING SPECIFICATIONS. AND 
ANY REPEAT COUNT SPECIFICATION. 

COUNT - N - A REPEAT COUNT SPECIFICATION WHICH DENOTES THE 
NUMBER OF TEXT LINES/LINE-SETS UPON WHICH THE 
COMMAND WILL ACT. AS APPLICABLE. IF IT DOES 
APPLY. BUT IS NOT SPECIFIED. IT IS ASSUMED TO 
BE EQUAL TO ONE. 


INTEGER*2 CLINE(90>.CTYPE.COUNT. IX 

LOG I CAL'** I BLANK . STR 1< 8 1 ) . STR2 < 8 1 ) . CX < 2 ) . ALLUF . ALLDWN 

EQUIUALENCE <IX.CX> 

COHMON/CF./uSE'NClINE. CLINE. CTYPE. COUNT. STRl . STR2. NSTRl . 
I NSTR2.ALLUP. ALLDWN 
COMMON/^LP/LPUNIT 
CTYPE=0 
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COUNT* I 
NSTRl-e 
NSTR2-e 
DO 90 >1/81 
STRKJ>*0 
90 STR2<J>-0 
RLLUP-. FALSE. 

ALLDNN* . FALSE • 

NCLINE«HIN0(HAX0<0^ NCLINE> < 80> 

IF<NCLINE.EQ.O> GO TO 90000 
100 IF<CLINE<NCLINE>.NE. ' O GO TO 200 
NCLINE-NCLlNE-1 
IF<NCLINE.EQ.O> GO TO 90000 
GO TO 100 
200 CONTINUE 

IF<CLlNE<l).EQ.lHR.OR.CLINE<l>.EQ.lHr> GO TO 1000 
IF<CLlNEa>.EQ.lHS.OR.CLINE<l>.EQ.lHf> GO TO 2000 
IF<CLINE<l>.EQ.lHN.OR.CLlHE<l>.EQ.lHn> GO TO 3000 
IF<CL1NE<1>.EQ.1HL.0R.CLINE(1>.EQ.1H1> GO TO 4000 
IF<CLINE<l>.EQ.lHF.OR.CLINE<l>.EQ.lHi> GO TO 5000 
IF<CLINE<l>.EQ.lHA.OR.CLINE<l>.EQ.lHa> GO TO 0000 
IF<CLINE<l>.EQ.lHD.OR.CLINE<l>.EQ.lHd> GO TO TOOO 
IF(CLINE<l>.EQ.lHE.OR.CLINE(l>.EQ.lHa> GO TO 9000 
IF<CLINE<l>.EQ.lHC.0R.CLINE<l>.E0.1Hc> GO TO 10000 
IF<CLINEa>.EQ.lHH.OR.CLIHE<l>.EQ.lHh> GO TO 15000 
GO TO 90000 

RESET 

1000 CTYPE-1 

IF<CLINI:<2>.EQ. lHS.0R.CLIN£<2>.EQ.lHs> GO TO SO00 
GO TO 90000 

SET 

2000 IF<CLINE<2>.EQ.lHT.0R,CLINE<2>.EQ.lHt> GO TO llOOO 
CTYPE-2 
KPOS-3 
COUNT- I 

1F<CL1NE<2>.EQ.1H;> GO TO 20000 
IF<CLINE<2>.NE.lHi> GO TO 90000 
CTYPE-0 
IDL1«CL1NE<3) 

KPOS-4 

IF<KPOS.GT.NCLINE> GO TO 9000O 
2100 IF<CLINE<KP0S>.EQ.IDL1) GO TO 22O0 
NSTRl-NSTRl+1 

IF<NSTR1.GT.S0) GO TO 9000O 
IX»CLINE<KPOS> 

STRU'NSTR1)»CX<1> 

KFOS-KPOS+1 

IF<KPOS.GT.NCLINE) GO TO 9000O 
GO TO 2100 

2200 IF<NSTRl.EQ.O) GO TO 9000O 
STRi<NSTRl+l>=0 
CTYPE-2 
KPOS-KPOS+2 

IFv'KPOS.GT.NCLINE) GO TO 90000 
IF<CLINE<KP0S-'1>.EQ.1H. ) GO TO 20OO0 
GO TO 90000 
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C 
C 
C 

CTYPE-3 

RLLDHN-.TRUE. 

TF<.N0T.(CLINE<2>.EQ.1H; .AND.CL1NE<3> .EQ. 1H>. AND. 
1 CLINE<4>.EQ.1H«>> GO TO 3010 

ALLDHN-. FALSE. 

ALLUP-.TRUE. 

GO TO 90000 

3010 IF<CLlNE<2>.NE.lHt> GO TO 90000 
CTVPE-O 
IDL1>CLINE<3> 

KPOS-4 

IF<KPOS.GT.NCLINE> GO TO 90000 
3100 IF<CLINE<KP0S>.EQ.IDL1> GO TO 3200 
NSTRl-NSTRl+1 

IF<NSTR1.GT.80> GO TO 90000 
IX-CLINE<KPOS> 

STRKNSTR1)»CX<1) 

KPOS-KPOS+1 

IF<KPOS.GT.NCLINE> GO TO 90000 
GO TO 3100 

3200 IF<NSTRl.EQ.e> GO TO 90000 
STRKNSTRl+D-O 
CTYPE»3 

IFCKPOS.GT.NCLINE) GO TO 90000 
IF<CLINE<KP0S-1>.EQ.1H;> GO TO 20OCO 
GO TO 90000 
C 

C LIST 

C 

4000 CTYPE-4 

IF<CLINE<2>.EQ.1H; . AND. <CLINE<3) .EQ. IHE.OR. 

1 CLINE<3>.EQ.lHi>> GO TO 14000 
KP0S»3 

IF<CLINE<2>.EQ. IH;) GO TO 20000 
IF<CLINE<2).NE.1H:> GO TO 90000 
CTYPE-0 
IDL1»CLINE<3> 

KP0S»4 

IF<KPOS.GT.NCLINE) GO TO 90000 
4100 IF<CL1NE<KP0S>.EQ.IDL1> GO TO 420O 
NSTR1=NSTR1+1 

IF<NSTR1.GT.80> GO TO 90000 
IX=CLINE<KPOS) 

STRKNSTR1>»CX<1) 

KP0S»KP0S+1 

IF<KPOS.GT.NCLINE) GO TO 90O00 
GO TO 4100 

4200 IF<NSTR1.EQ.0> GO TO 90000 
STRKNSTR1+1>=0 
CTYPE=4 
KP0S=KP0S+2 

IF<KPOS.GT.NCLINE> GO TO 900O0 
IF<CLINE<KP0S-1>.EQ.1H;> GO TO 2O000 
GO TO 90000 
C 

C FIND 
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c 

5000 CTYFE«5 
KP0S*3 

IF<CLINE<2>.EQ.1H;> GO TO 200OO 
IF<Cl.lNE<2>.l€.lHi> GO TO 90000 
CTYPi-0 
1DL1>CLINE<3> 

KPOS-4 

IF<KP0S.GT.NCL1NE> GO TO 90000 
5100 IF<CLINE<KP0S>.EQ.IDL1> GO TO 5200 
NSTRl-NSTRl+l 

IF(NSTR1.GT.80> GO TO 90000 
IX-CLINE<KPOS> 

STR1<NSTR1)«CX<1> 

KPOS-KPOS+l 

IF<KPOS.GT.NCLINE> GO TO 90000 
GO TO 5100 

5200 IF<NSTR1.EQ.0> GO TO 90000 
8TR1<NSTR1+1)«0 
CTYPE-5 
KP0S>KP0S-t>2 

1F<KP0S.GT,NCLINE> GO TO 9OO0O 
1F<CLINE<KP0S-1>.EQ.1H.> GO TO 20O00 
GO TO 90000 

ADD 


6000 CTYPE-6 
KPOS-3 

IF<CLINE<2>.EQ.1H;> GO TO 200OO 
IF<CLINE<2>.NE.1H!> go to 90000 
CTYPE-0 
1DL1-CL1NE<3> 

KPOS-4 

IF<KPOS.GT.NCLINE) GO TO 900O0 
6100 IF<CLINE<KP0S>.EQ,IDL1> GO TO 620O 
NSTRl-NSTRl+1 

IFCNSTR1.GT.80) GO TO 90800 
IX-CLINE<KPOS) 

STRKNSTR1)«CX<1) 

KPOS-KPOS+1 

IF<KPOS.GT.NCLINE) GO TO 90800 
GO TO 6100 

6200 1F<NSTR1.EQ.0> GO TO 90800 
STRKNSTR1+1)»0 
CTYPE-6 
KPOS-KPOS+2 

IF<KPOS.GT.NCLINE> GO TO 90808 
IF<CLINE(KP0S-1).EQ.1H,> GO TO 28800 
GO TO 90000 

DELETE 

7000 CTYPE-7 

IF<CLINE<2>.E0.1HS.0R.CLINE<2>.EQ.lKs> GO TO 13880 
KPOS-3 

IF<CLINE^2>.EQ.1H, > GO TO 20080 
IF<CLINE's2>.NE.lH:> GO TO 90880 
CTYPE-0 
IDL1=CLINE<3) 
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KF0S«4 

IF<KPOS.GT.NCLINE) GO TO 90000 
7100 IF<CLINE<KP0S>.EQ.IDL1> GO TO 7200 
NSTRl«NSTRl+l 

IF<NSTR1.GT.60> GO TO 90000 
IX-CLINE<KPOS> 

STR1<NSTR1>-CX<1> 

KPOS-KPOS-^l 

IF<KPOS.GT.NCLINE> GO TO 90000 
GO TO 7100 

7200 IF<NSTRl.EQ.e> GO TO 90000 
STRKNSTR1+1>»0 
CTYPE-7 
KPOS-KPOS+2 

IF<KPOS.GT.NCLINE> GO TO 90000 
IF<CLINE<KP0S-1>.EQ.1H, > GO TO 20000 
GO TO 90000 

REPLACE STRING 


8000 CTYPE-0 

IF<CLINE<3).NE.lHi) GO TO 90000 
IDL1«CLINE(4> 

IF<CLINE<4>.EQ. ' ^0R. CLINE<4> . EQ. 0> GO TO 90000 
KP03>5 

IF<KPOS.GT.NCLINE> GO TO 90000 
3100 IF(CLINE<KP0S).EQ.IDL1> GO TO 3200 
NSTRl-NSTRl+1 

IF<NSTR1.GT.80> GO TO 90000 
1X-CLINE<KP0S) 

STR1<NSTR1)»CX<1) 

KPOS-KPOS+1 

1F<KP0S.GT.NCL1NE> GO TO 90000 
GO TO 8100 

8200 lF<CLINE<KPOS-»-l>.EQ.lH .OR.KPOS.EQ.NCLINE) GO TO S410 
IF(CLINE<KP0S+1>.EQ.1H;> GO TO 3410 
IF<CLINE<KP0S+1>.NE. 1H,> GO TO SOOOO 
IDL2»CLINE<KP0S+2) 

IF<CLINE<;KP0S+2).EQ. ' '.OR.CLINE<KPO£+2>.EO.0> GO TO 9OOO0 
KPOS-KPOS+3 


8300 


8400 

3410 


IF<KPOS.GT.NCLINE> GC TO 9O000 
IF(CLINE<KP0S).EQ.IDL2) GO TO 8400 
NSTR2-NSTR2+1 

IF<NSTR2,G'".80) GO TO 90O00 
IX«CLINE<KP0S) 

STR2<N£TR2>=CX< 1 > 

KP0£=KP0S+1 

IF<KPOS.GT.NCLINE> GO TO 90000 
GO TO 8300 

IF<NSTR1.EQ.0.OR.NSTR2.EG.0> GO TO 900G0 

STR1<NSTR1+1)=0 

STR2<NSTR2+1)»0 

CTYPE*8 


KP0S*KP0S+2 

IF<KPOS,GT.NCLINE> GO TO 90000 

if<cline«;kpos-i>.eq.ih, ) go to 20000 

GO TO 90000 


EXTRACT 
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90CMD IF<CLlNEs2>.EQ.lKH.0R.CLIN£\2>.E0.1Hn^ GO TO 12000 
KPOS-3 
CTYPE-9 

1F<CLINE<2>.EQ.1H,> GO TO 20000 
1F<CLINE<2>.NE.1H(> GO TO 90000 
CTYPE-0 
1DL1«CLINE<3> 

KP0S>4 

IF<KPOS.GT.NCLINE> GO TO 90000 
9100 IF<CL1NE<KP0S>.EQ.1DL1) GO TO 9200 
NSTRl-NSTRl-t-l 

1F<NSTR1.GT.80> GO TO 90000 
IX»CLINE<KPOS) 

STRKNSTR1)-CX<1) 

KPOS-KPOS+l 

IF(KPOS.GT.NCLINE) GO TO 90O0O 
GO TO 9100 

9200 1F<NSTR1.EQ.0> GO TO 90000 
STRKNSTRl+D-O 
CTYPE-9 
KPOS-KPOS+2 

1F<KP0S.GT.NCLINE> GO TO 90000 
IF<CLINE(KP0S-1>.EQ.1H;> GO TO 20000 
GO TO 90000 
C 

C CLEAR 

C 

10000 CTVPE*10 

GO TO 90000 
C 

C STOP 

C 

11000 CTYPE*11 

GO TO 90000 
C 

C END 

C 

12000 CTYPE».' 2 

GO TO 90000 
C 

C DELETE STRING 

C 

13000 CTYPE*'3 

IF<CLINE<3>.NE.lHi) GO TO 9O000 
IDL1=CLINE<4> 

KP0S=5 

IF<KPOS.GT.NCLINE> GO TO 9600O 
13100 IF<CLINE<KP0S>.EQ.IDL1) 60 TO 132O0 
NSTR1=NSTR1+1 

IF<NSTR1.GT.80> GO TO 9O000 
IX=CLINE<KPOS> 

STRl<NSTRl>=CXkl) 

KP0S*KF'0S+1 

IFvKPOS.GT.NCLIHE) GO TO 9000O 
GO TO 13100 

13200 IF<NSTR1.EQ.0> GO TO 90000 
STRKNSTR1 + 1)*0 
CTYPE«13 
KP0S«KP0S+2 

IF<KF'OS.GT.NCLINE> GO TO 90000 
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IF<CLIHE<KP0S-1>.EQ.1H,> GO TO 20000 
GO TO 90000 
C 

14000 CTYPE-14 

GO TO 90000 
C 
C 

C HELP 

C 

C 

ISeOO CTYPE-15 

GO TO 90000 
C 
C 

C ( COUNT 

C 

C 

20000 K«1 

C0UNT>0 

IF<CLINE<KPOS>.EQ.lHv> GO TO 21000 

IF<CLINE<KPOS).EQ.lH-.flND,CLINE<KPOS+l).EQ.lH‘«‘) GO TO 22000 

IF<KP0S.GT.NCL1NE)G0 TO 9000O 

DO 20100 J-NCLINE^KP0S/-1 

IF<CLINE<J>.EQ.lH-> GO TO 20200 

IX>CLINE<J> 

KN>0 

KN»CX< 1 > 

KN-KN-48 

IF<KN.LT.0.OR.KN.GT.9) GO TO 2030O 
COUNT-COUNT+K*KN 
20100 K-K«10 
RETURN 

20200 COUNT— COUNT 
CO TO 90000 
20300 C0UNT>0 

GO TO 90000 
21000 HLLDHN-.TRUE. 

COUNT- 1 
GO TO 90000 
22000 RLLUP-.TRUE. 

COUNT- 1 
GO TO 90000 
C 
C 

c 

c 

c 

90060 RETURN 
END 

INTEGER FUNCTION IFIND<N1.N2,STR1,STR2. IPOS:* 

CUOX CH«R«CTER*137 CSTRl 

CUftX CH«RflCTER=+‘Sl CSTR2 

LOGICAL*! STR1<137>.STR2(81> 

IFIND-0 

IF<N1.LT.I.OR.N2.LT.1.0R.IPOS.LT.1.0R.N1.GT.135.0R. 

1 N2.GT.81,OR.IPOS.GT.135.0R.IPOS.GT.H1> RETURN 
CUAX DO 100 J-IPOS.Nl 

CUfiX JJ-J+l-IPOS 

CUfiX 100 CSTRKJJi JJ>=CHPR<STR1<J:'> 

CUAX DO 200 J-1/N2 
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cwx 

CLSl 

CVfiX 

CUAX 


C 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 

c 


200 CSTR2<Ji 

IF I ND« I NDEX < STR I , STR2 / 1 POS > 
IFIN£>«IN0EX<CSTR1<i<NU1-IP0S>),CSTR2uN2p; 

IF<IF1ND.NE.0> IFIN&-IF!ND*i<»>IPOS 
RETURN 
END 

SUeROUTlNE RECHGR<.IOF>LRECN.LASTRC;NEXTRC/NCREC/REC. lERR/KBUFF. 
1 SBLOCK) 


RECORD HRNRGER ROUTINE FOR LINE-ORIENTED TEXT EDITOR 

lOF « 0 ■ INITIALIZE CALL^ REQUIRED 

- 1 - NRITE A RECORD 
> 2 • READ A RECORD 

- 3 - RESET EXISTING POINTERS ONLV 

- 4 > READ EXISTING POINTERS ONLV 

LRECN - LOGICAL RECORD NUMBER 


KBUFF<1,J) - POINTER TO PREUIOUS LOGICAL RECORD 
<2.J> > POINTER TO NEXT LOGICAL RECORD 
<3.J) ■ PHYSICAL RECORD CONTAINING J'TH LOGICAL RECORD 
<4.J) - BYTE IN BLOCK FOR START OF J'TH LOGICAL RECORD 
(3,J> > RESERUED LENGTH OF J^TH LOGICAL RECORD 
<6/J) - STORED LENGTH OF J'TH LOGICAL RECORD 


KB * KEY BUFFER BLOCK FOR LRECN 

KBPOS » KEY BUFFER BLOCK POSITION FOR LRECN 

NKBUFF « TOTAL NUMBER OF POINTER BLOCKS 

NSBUFF * TOTAL NUMBER OF DATA BLOCKS 

THISKB « INDEX OF CURRENT POINTER BLOCK 

THISSB * INDEX OF CURRENT DATA BLOCK 

MAXLR » TOTAL NUMBER OF LOGICAL RECORDS 


C SBVTE » STARTING BYTE FOR NEXT RECORD IN THE BLOCK 

C LASTSB » LAST DATA BLOCK IN USE 

C 
C 


CLS 1 32 I NTEGER*2 KBUFF < 6 / S4 . 1 O ) , SBLOCK <256,10 > 

CLSI64 UIRTUAL KBUPF<6/64,49>,SBL0Ck<256,60) 
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CLSI96 UIR7LWL KBUFF^6.64/S5^/S6L0CKv256. liD 
CLSI128 OIRTUM. K8UFF<6/64/85>.3BL0CK^256/ 127> 

CUAX UIRTUAL K6UFF<6^B4/e9>;S6L0CK<258/ 127> 

1NTEGER‘«<2 SBLOCK/ S6YTE/ TRRNSl /NCREC. TH1SS6/ 

1 KBCET . SHT< 127> . Sl< 127) . SRCE< 127> / «BCNT . S6GET 
LOGICAL-**! SGUFF<5!2>»REC<!37> 

EOUlUALENCE (S6YTE/SBUFF<SU>> 

COHHON/KEYS/NKBUFF/HAXLR/KI <65> / KAGE<89> . KHT<8S> . KBCNT 
COMMON/'TEXT/NSBUFF> THISSB,LASTSB* SI . SAGE. SWT. SBCNT. ISB. SBUFF 
COMMON/LP/LPUNIT 
COHHON/HSIZE/INDREC. KNTKB. KNTSB 
lERR-e 
C 
C 

C SET KEY LOCATION 

C 

C 

KB«HAXe<0. <LRECN-l)/64>-i>l 
KBP0S-LRECN-<64-*<KB-l ) ) 

IF<KB.GT.10e> GO TO 8I00 
GO TO <100. !888. 2880. 3800. 4800). IOP+1 
C 
C 

C INITIALIZE 

C 

C 

188 NKBUFF-8 
NSBUFF-8 
THISSB»1 
LASTSB-1 
HAXLR-8 
KBCNT-8 
SBCNT-8 

IKB-KBGET<1.KBUFF) 

ISB«e 

CALL SBGET<SBLOCK) 

SBYTE-1 
SHT<ISB)-1 
GO TO 9088 
C 
C 
C 
C 
C 
C 
C 

C WRITE A RECORD 

C 

C 

C 

C 

C 

C 

C 

1000 IKB=KBGETCKB.KBUFF> 

IF<IKB.EQ.e> GO TO 8180 
NC»NCREC 

CALL SBGET < SBLOCK > 

IF(LRECN.LE.HAXLR> GO TO 1508 
1150 THISSB=LASTSB , 


non ooo o o o noo o o r> 


Ci^LL SEGET<SBLiXk> 


ADD NEH RECORD 

1200 K6UFF< 1 . K6P0S/ IKB)-LASTRC 
KBUFF<2> K6F0S/ 1KB>*NEXTRC 
KBUFF < 3 / KBPOS / IKB> -THZS8B 
KBUFF<4«KBP0S« IKB>-SBVTE 
KBUFF<5/KBP0S/ IKB>«NCREC 
KBUFF<B. KBPOS/ 1KB>«NCREC 
KHT<IKB>-. 

HAXLR-HAXO<HAXLR / LRECN) 
IF<(S6YTE4>NC>.GT.9U> GO TO 1300 

ALL FITS IN ONE 

DO 1220 J-l/NC 
1220 SBUFF<SBVTE~1+J)»REC<J) 
SBYTE-SBYTE+NC 
SNT<ZSB>-1 
Kl-NC 

1F<SBYTE.EQ.911> GO TO 1330 
GO TO 9000 

FITS ACROSS THO ^I-VSICAL BLOCKS 

1300 K1-911-S6YTE 
DO 1320 J-l/K) 

1320 SBUFF<SBYTE-1+J>-REC<J) 

SBYTE-Sll 
SNT<ISB>-1 
1330 TH1SSB-THISSB>^1 
LASTSB-THISS6 
CALL SBGET<SBLOCK> 

IFUSB.EQ.O) GO TO 3200 

SBVTE-1 

SHT<ISB)-1 

K2-NC-K1 

IF<K2.EQ.O) GO TO 9000 
DO 1360 J>l/K2 
1360 SBUFF<J)»REC<J+K1> 

SBYTE-SBYTE+K2 
SHT<ISB>-1 
GO TO 9000 

EXISTING RECORD 

1900 K1-KBUFF<3/ KBPOS/ IKB> 

K2»KBUFF<4/ KBPOS/ IKB> 
K3-KBUFF<:5/KBP0S/ IKB> 

^!aSSB»Kl 

CAuL SBCET<SBLOCK> 

1510 IF<NC.GT.K3) GO TO 1700 

NEH UERSION 0UERHRITE3 OLD SPACE 

KBUFF < 1 / KBPOS/ IKB)«LASTRC 
KBUFF < 2 / KBPOS / IKB > -NEXTRC 
KBUFF < 6 / KBPOS / IKB > *NCREC 
KHT<IKB>-1 
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IF^<K2rK3.'.CT.5U^ GO TO i40O 
C 

C FITS ON ONE BLOCK 

C 

DO 1920 J«1.NC 
1920 S6UFF<K2>14>J>«REC<J> 
SH7<ZSB>*1 
CO TO 9000 
C 

C SPANS BLOCKS 

C 

1600 K4-911-K2 

DO 1620 J-1.K4 
1620 S6UFF<K2-14-J)>REC<J> 
SHTUSB)-! 

THISSB-THISSB^l 
CALL SBGET<S8L0CK) 

K9-NC-K4 
DO 1660 >1.K9 
1660 S6UFF<J>«REC<J’^K4> 

SNT<1SB>-1 
CO TO 9000 
C 

C NEH UEKSION IS RELOCATED 

C 

1700 GO TO 1190 
C 
C 
C 
C 
C 
C 
C 

C READ A RECORD 

C 

C 

C 

C 

C 

C 

C 

2600 IKB-KBGET<K6/KBUFF> 

LASTRC-KBUFF( 1 , KBPOS, IKB> 
NEXTRC»KBUFF<2.KBP0S. IKB> 
K1-KBUFF<3,KBP0S,IKB> 
K2»KBUFF<4.KBP0S/ 
K3*kBUFF<5,KBP0S, 1KB ^ 
NCREC»KBUFF<6,KBP0S, IKB> 
IF<<K2-*-K3).GT.5U) GO TO 2100 
C 

C FITS ON ONE BLOCK 

C 

TH1SSB»K1 

CALL SBGET<SBLOCK> 

DO 2030 J>1.K3 
2030 RECU>*SBUFF(K2-1+J) 

GO TO 9000 
C 

C SPANS BLOCKS 


OOOOO OOOOO ooooo ooooo ooooo 


2106 K4-511-K2 
K5-K3-K4 
THISSB-Kl 

CALL SBGET<S6L0CK> 
DO 2120 >1/K4 
2120 REC<J)-SBUFF<K2-14-J) 
THISSB-THlSSB^l 
CALL S6GET<SBL0CK) 

DO 2130 J-l/KS 
2130 RECOK4>«SBUFF<J> 

GO TO 9000 


RESET EXISTING POINTERS 


IKB-KBGET<KB/KBUFF> 

KBUFF< 1 .KBPOS/ IKB)-LASTRC 
KBUFF<2.KBP0S. IKB>-NEXTRC 
KHT<IKB)«1 
GO TO 9000 


READ EXISTING POINTERS 


4000 IKB-'KBGET<K6.K6UFF> 

LASTRC*KBUFF< 1 , KBPOS. IKB) 
NEXTRC»KBUFF<2.KBP0S> IKB> 
GO TO 9000 


8100 WRITE<6.901> 
IERR>1 
GO TO 9000 
8200 HRITE<8.902> 
lERR^l 
GO TO 9000 


9000 CONTINUE 

9001 RETURN 


901 FORMAT <2X.. '♦**** ATTEMPT TO WRI'.E TOO MANY LOGICAL RECORDS' 

1 •' ON SCRATCH FILE ■*****') 

902 F0KMAT<2X . •'*♦**=♦■ END OF FILE ON SCRATCH FILE *****•') 

END 

INTEGER FUNCTION KBGET*2<KB,KBL0CK> 
r'.SI32 INTEGER^*2 K5L0CK<6,o4. 10> 

CLSI84 UIRTUAL K3L0CK<6,64.4’9> 
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CLllU VIRTUAL KBL0CK<e.64/35> 

CLSI128 UIRTUAL KEL0CK(8/ 64/35) 

CUAX giRTUAL KBL0CK<6/64/85> 

COMMON/KEYS/NKBUFF/ MfiXLR/ KK85) / KrtCECSS) / KWT<85) / KBChlT 
COMMON/LP/LPUNIT 
COHMON/HSIZE/ INDREC / KNTKB/ KNTS8 
C 
C 

C INITIfiL POSS TO FILL BUFFERS 

C 

c 

IF<KBCNT.EQ.KNTKB) GO TO 1800 
IF<KBCNT.EQ.e> GO TO 560 
DO 108 J-l/KBCNT 
IF<K6.EQ.KKJ)> GO TO 280 
188 CONTINUE 
GO TO 588 
208 KPOS-J 
GO TO 9888 
C 

C fiDD NEH BUFFER 

C 

588 KBCNT-KBCNT+1 
DO 608 >1/64 
DO 688 I»l/6 
688 KBL0CK<I/J/KBCNT)*0 
KWT<KBCNT)»1 
KKKBCNT)»KB 
KNGE<KBCNT)»1 
NKBUFF»KB 
DO 788 >1/KBCNT 

708 IF<J.NE.KBCNT) KPIGE<J>*KflGE«;j)+l 
KPOS*KBCNT 
GO TO 9888 
C 

C fiLL FULL 

C 

1888 KP0S*8 

DO 1188 >1/KNTKB 
IF<KI<J).EQ.KB) GO TO 1288 
1188 CONTINUE 
GO TO 2888 
1208 KPOSsJ 

GO TO 9888 
C 

C ROTATE BUFFERS 

C 

2888 DO 2188 >1/KNTKB 

IF<KAGE<J).EQ.KNTKB) CO TO 2288 
2188 CONTINUE 
STOP 8883 
2288 KPOS=J 

IF<KNT<KP0S).NE.8) 


C 

C 


1 HR I TE < 1 " K K KPOS ) / END= 9988 ) < < KBLOCK < I / J / KPOS > 
IF<KB.GT,NKBUFF) GO TO 2388 


READ<1'KB) 
KWT<KP0S)=8 
GO TO 2408 


( ^ KBLOCK ^ I / J / KPOS) > I— 1/6^* / U®1 / 64) 


1*1/6)/ -.i* 1 / 64 


CREATE NEW BLOCK 
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2300 DO 2310 >1.64 
DO 2310 1-1/6 
2310 KBLOCK< I / J. KF0S>-0 
KHT<KP0S>-1 
NKBUFF-KB 
C 

C SET POINTERS 

C 

2400 KRGE<KP0S>-1 
KKKPOS>-KB 
DO 2410 J-1/KNTK6 
IF<J.NE.KPOS> KflCE<J>»KfiGE(J)+l 
2410 CONTINUE 
C 
C 
C 

9000 KBGET-KPOS 
RETURN 

9900 KBGET-O 
RETURN 
END 

SUBROUTINE SBGET<SBLOCK> 

CLSI32 INTEGER*2 SBL0CK<256/ 10> 

CLSI64 UIRTURL SBL0CK<256/60> 

CLSI96 UIRTUfiL SBL0CK<256. 127> 

CLSI128 UIRTUfiL SBL0CK<256/ 127) 

CUfiX UIRTURL SBL0CK<256/ 127) 

INTEGER*2 SBUFF ( 256 ) > SPOS . SBLOCK / S I <1 27 ) / SAGE (1 £7 ) / SWT a 27 ) / 
1 SBCNT/THI33B 

COMHON/TEXT/NSBUFF/ THISSB/LASTSB. SI > SAGE. SWT. SBCHT.. ISB.. SBUFF 
COMHON-'LP/LPUNIT 
COHHON/MSIZE^ INDREC/ KNTKB/ KNTSB 
C 
C 

C INITIAL PASS TO FILL BUFFERS 


IF<SBCKT.EQ.KNTSB) GO TO lOOO 
IF<SBCNT.EQ.O) GO TO 500 
DO 100 J-l/SBCNT 
IFaHISSB.EQ.SKJ)) GO TO 20O 
160 CONTINUE 
GO TO 500 
200 SPOS-J 

IF < SPOS. EQ. ISB) GO TO 9O00 
DO 210 >1/256 
210 SBLOCK <J/ISB)*SBUFF<J) 

DO 220 >1/256 
220 SBUFF<J)=SBLOCK(J/SPOS) 

GO TO 9000 
C 

C ADD NEW BUFFER 

C 

500 SBCNT-SBCNT+1 

IF< I SB. EQ.0) GO TO 550 
DO 510 >1/256 
510 SBLOCK < J. . ISB) -SBUFF U) 

550 DO 600 >1/256 
SBUFF<J>-0 
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6iD0 SBLOCK < J ; SECNT > »0 
SWT<SBCNT>«1 
SKSBCNT>>THISSB 
NSBUFF>THISS6 
SACE<SBCNT>-1 
DO 700 J-l/SBCNT 

700 IF<J.NE.S6CNT> SAG£<J>>SACE<J>-)>1 
SPOS-SBCNT 
GO TO 9000 
C 

C fiLL FULL 

C 

1000 SPOS-e 

DO 1100 J-l.KNTSB 
IF<SI(J>.EQ.THISSB> GO TO 1200 
1100 CONTINUE 
GO TO 2000 
1200 SPOS-J 

IF<SPOS.EQ.ISB> GO TO 9000 
DO 1210 J-1.25B 
1210 SBLOCK<J.ISe>*SBUFF<J) 

DO 1220 J-1.25B 
1220 SBUFF<J>*SBLOCK<J,SPOS) 

GO TO 9000 
C 

C ROTATE BUFFERS 

C 

2000 DO 2100 J-l/KNTSB 

IF<SAGE<J>.EQ.KNTS6> GO TO 2200 
2100 CONTINUE 
STOP 7777 
2200 SPOS*J 

DO 2210 >1.250 
2210 SBLOCK<J.ISB>»SBUFF<J) 

IF<SWT<SPOS> .NE . O) WRITE<2'SI <SPOS) . END=95O0> <SBLOCKs J, SPOS> . 
I >1,256> 

IF<THISSB.GT.NSBUFF> GO TO 23O0 

RE AD < 2 •' TH I SSB ) < SBLOCK < J , SPOS > . J= 1 . 256 > 

DO 2250 >1.256 
2250 SBUFF<J>=SBLOCK<J.SPOS> 

SMKSPOS>=0 
GO TO 2400 
C 

C CREATE NEW BLOCK 

C 

2300 DO 2310 >1.256 
SBUFF<J>=0 

2310 SBLOCK <J. SPOS >=0 
SHT<SP0S>=1 
NSBUFF=THISSB 
C 

C SET POINTERS 

C 

2400 SAG£(SPOS>sl 

SKSPOS>=ThISSB 
DO 2410 >1.KNTSB 
IF<! J. NE . SPOS) SAGE< J)*SAG£<. J)+l 
2410 CONTINUE 
C 
C 
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O O O O O CJ o O ^ CJ o o 


ccccccccccccccccccccccccccccccccnccccccccccccccccccccccccccccccccccccccc 

c 

C ♦ ♦ 

C + i*i 

C ■* TECHNOLOG'i' INCORPORfiTED 

C LIFE SCIENCES DIVISION « 

C * DEPflRTHENT OF BIOHfiTHEHfiTICS SERUICES * 

C * * 

c * * 

Q 4i-»i:tM4i4<4i4<'4s!«<i4i4i4ii4i!4i4i4<!4<4<s(<itt>4ti4:stii4i!4!S4i!4<s4!4i:4<;4i4s4i:(:-4i:t:4:4i«4i4i4i4<s<<'4i;4si«>s<<!t<i«i4>4!s|c>t<4:4is«ii4:4:!«i:»:«iti:4::4i4!>4i4t4'' 

C '* ♦ 

c * * 

C ♦ PROCRflH NflHEi COPYSB ♦ 

C ^ DESIGHER/ ANRLVSTi 1 1 . • CRRIG E. LITTON * 

C * PROGRflMHERi SCOTT G. THOMPSON * 

C ♦ DOTE SEPTEMBER 1 581 * 

C * * 

c * ♦< 

C 

c * ♦ 

C ♦ 

C ♦ COMPUTER SYSTEM i LS I - 1 1 . UfiX- 1 1 / 730 * 

C * OPERATING SYSTEM) RT-llv4, UfiX-'UMS ♦ 

C * * 

C * * 

C * * 

c * * 

C * COMPILING SEQUENCE) * 

C * * 

C * LSI) REMOUE CLSI COMMENTS * 

C ♦ COMPILE) FORTRAN COPYSB f 

C ♦ + 

c * UfiX) REMOUE CUfiX COMMENTS 

* COMPILE) F0RTRflN.-N0l4 COPYSEF * 

■* + 

■* * 

* :H 

* LINKING SEQUENCE) ♦ 

* H 

* LSI) LINK COPYSB 

:)( 

* UAX) LINK C0PV3BF * 

* 

.♦ 

* 

* EXECUTION SEQUENCE) RUN COPYSB <LSI) 4' 

** RUN COPYSBF <UflX> * 
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PROGRAM COPYSBF 
C 

C THIS PROGRAM COPIES A FILE AND INSERTS 

C A SPACE IN COLUMN I AND SENDS THE OUTPUT TO 

C THE LINE PRINTER 

C 

LOGICAL'**! LINE<5120>>FILE<40> 

1! F0RMAT<Q/64<80A1>> 

CUAX 12 F0RMAT<1H1> 

13 FORMAT<40< IX/ 130A1' ) ) 

14 FORMAT<' FILE • ',$> 

15 FORMAT <Q/40A1> 

CUAX IUNIT-2 

CLSI IUNIT-6 

100 TYPE 14 

ACCEPT 15/NC/<FILE<J>/J»1/NC> 

FILE<NC+1)«0 

OPEN<UNIT»l / NAME»FILE, TYPE-'OLD' / ACCESS- "SEQUENTIAL ' / 

‘ FORM- "FORMATTED" / DISPOSE-'KEEP" / CARR I AGECONTROL-" FORTRAN , 
2 RECORDSIZE-5120/ERR-190> 

CLSI GO TO 2000 

CUAX GO TO 1000 

190 TYPE ■+/ " ERROR IN FILE NAME/ RETRY" 

GO TO 100 

CUAX 1000 0PEM<UNIT»2/ NAME- "COPYSBF . OUT " / TYPE- 'NEH / ACCESS- 
CUAX 1 "SEQUENTIAL" / FORM- "FORMATTED" / DISPOSE-"PRINT-"DELETE" - 

CUAX 2 CARRIAGECONTROL»"FORTRAN"> 

CUAX HRITE<IUNIT/12) 

2000 NLINES-0 

2001 READ( 1/11/ EMD-3000> NC/ <LINE< J> / J-1 / NO 
NLINES-NLINES+l 

IF<MOD<NLINES/1000>.EQ.0> TYPE NUMBER OF LINES = "/ 

1 NLINES 

HRITE<IUNIT/13> <LINE<J)/J-l/NO 
GO TO 2001 

3000 TYPE ♦/" NUMBER OF LINES - "/NLINES 
CALL EXIT 
END 
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